Theory Phi_Type

theory Phi_Type
  imports IDE_CP_Reasoning2
  keywords "φtype_def" "φproperty_deriver" "let_φtype" "φtypeclass" :: thy_defn
       and "deriving" "parameter_equality" :: quasi_command
begin

chapter ‹The Algebra of φ›-Type›

section ‹Algebraic Properties of φ-Types›

subsection ‹Auxiliary Preliminaries›

subsubsection ‹Conditioned Operators›

definition cond_splitR ("?sR") ― ‹conditioned module split at right›
  where ?sR C f = (if C then f else (λx. (x, unspec)))

definition cond_splitL ("?sL") ― ‹conditioned module split at left›
  where ?sL C f = (if C then f else (λx. (unspec, x)))

abbreviation cond_splitR' ("?sR[_]" [30] 1000)
  where ?sR[C]  ?sR (LPR_ctrl C)

abbreviation cond_splitL' ("?sL[_]" [30] 1000)
  where ?sL[C]  ?sL (LPR_ctrl C)

lemma cond_split_red[simp, φsafe_simp]:
  ?sR True f = f
  ?sR False f = (λx. (x, unspec))
  ?sL True g = g
  ?sL False g = (λx. (unspec, x))
  unfolding cond_splitR_def cond_splitL_def
  by simp_all

definition cond_unionR ("?jR") ― ‹conditioned module split at right›
  where ?jR C f = (if C then f else fst)

definition cond_unionL ("?jL") ― ‹conditioned module split at left›
  where ?jL C f = (if C then f else snd)

abbreviation cond_unionR' ("?jR[_]" [30] 1000)
  where ?jR[C]  ?jR (LPR_ctrl C)

abbreviation cond_unionL' ("?jL[_]" [30] 1000)
  where ?jL[C]  ?jL (LPR_ctrl C)

lemma cond_union_red[simp, φsafe_simp]:
  ?jR True f = f
  ?jR False f = fst
  ?jL True g = g
  ?jL False g = snd
  unfolding cond_unionR_def cond_unionL_def
  by simp_all

lemma cond_union_simp[simp, φsafe_simp]:
  ?jR C fst = fst
  unfolding LPR_ctrl_def cond_unionR_def
  by simp_all


definition cond_mapper :: bool  (('a  'b)  'c  'd)
                                 (('a  'b)  'c  'd) ("?M")
  where ?M C m = (if C then m else (λ_ _. unspec))

abbreviation cond_mapper' ("?M[_]" [30] 1000)
  where ?M[C]  ?M (LPR_ctrl C)

lemma cond_mapper_red[simp, φsafe_simp]:
  ?M True m = m
  ?M False m f = (λ_. unspec)
  unfolding cond_mapper_def
  by simp_all

lemma cond_mapper_simp[simp, φsafe_simp]:
  ?M C (λ_ _. unspec) = (λ_ _. unspec)
  unfolding LPR_ctrl_def cond_mapper_def
  by simp_all

paragraph ‹mapToA_assign_id›

lemma [φreason %mapToA_assign_id+10]:
  𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[𝗌𝖺𝖿𝖾] C
 mapToA_assign_id (m f)
 mapToA_assign_id (?M C m f)
  unfolding mapToA_assign_id_def Premise_def 𝗋Guard_def
  by clarsimp

lemma [φreason %mapToA_assign_id+20]:
  mapToA_assign_id (m f)
 mapToA_assign_id (?M[True] m f)
  unfolding mapToA_assign_id_def Premise_def 𝗋Guard_def
  by clarsimp

lemma [φreason %mapToA_assign_id+30 for mapToA_assign_id (?M _ _ _ :: unit  unit)
                                        mapToA_assign_id (?M[False] _ _ :: ?'a  ?'a),
       φreason %mapToA_assign_id    for mapToA_assign_id (?M _ _ _ :: ?'a  ?'a)]:
  mapToA_assign_id (?M C m f :: unit  unit)
  unfolding mapToA_assign_id_def
  by (clarsimp simp: fun_eq_iff)

lemma [φreason %lookup_a_mapper]:
  𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[𝗌𝖺𝖿𝖾] C
 IDE_CP_Reasoning2.lookup_a_mapper (m f) x y
 IDE_CP_Reasoning2.lookup_a_mapper (?M C m f) x y
  unfolding IDE_CP_Reasoning2.lookup_a_mapper_def Premise_def 𝗋Guard_def
  by simp

lemma [φreason %lookup_a_mapper+10]:
  IDE_CP_Reasoning2.lookup_a_mapper (m f) x y
 IDE_CP_Reasoning2.lookup_a_mapper (?M[True] m f) x y
  unfolding IDE_CP_Reasoning2.lookup_a_mapper_def
  by simp

lemma [φreason %lookup_a_mapper+10]:
  𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[𝗌𝖺𝖿𝖾] y' : y
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 y' = unspec
 IDE_CP_Reasoning2.lookup_a_mapper (?M[False] m f) x y
  unfolding IDE_CP_Reasoning2.lookup_a_mapper_def Premise_def Simplify_def
  by simp


subsubsection ‹Conditioned Zip \& Unzip›

definition cond_zip ("?Z")
  where ?Z C z mapper = (if C then z else mapper (λx. (x, unspec)) o fst)

definition cond_zip2 ("?Z2")
  where ?Z2 C z mapper = (if C then z else mapper (λx. (x, unspec)) (λx. (x, unspec)) o fst)

definition cond_zip_dom ("?ZD")
  where ?ZD C D D' R' = (if C then D else {x. a. a  D' (fst x)  (a, unspec)  R' (fst x)})

definition cond_zip_dom2 ("?ZD2")
  where ?ZD2 C D D'1 D'2 R'1 R'2 = (
    if C then D else {x. (a. a  D'1 (fst x)  (a, unspec)  R'1 (fst x)) 
                         (a. a  D'2 (fst x)  (a, unspec)  R'2 (fst x)) })

definition cond_unzip ("?UZ")
  where ?UZ C uz mapper = (if C then uz else (λx. (mapper fst x, unspec)))

definition cond_unzip_dom ("?UZD")
  where ?UZD C D1 D2 R' = (if C then D1 else {x. (a,b)  D2 x. a  R' x})


abbreviation cond_zip' ("?Z[_]" [30] 1000)
  where ?Z[C]  ?Z (LPR_ctrl C)

abbreviation cond_zip'2 ("?Z2[_]" [30] 1000)
  where ?Z2[C]  ?Z2 (LPR_ctrl C)

abbreviation cond_zip_dom' ("?ZD[_]" [30] 1000)
  where ?ZD[C]  ?ZD (LPR_ctrl C)

abbreviation cond_zip_dom'2 ("?ZD2[_]" [30] 1000)
  where ?ZD2[C]  ?ZD2 (LPR_ctrl C)

abbreviation cond_unzip' ("?UZ[_]" [30] 1000)
  where ?UZ[C]  ?UZ (LPR_ctrl C)

abbreviation cond_unzip_dom' ("?UZD[_]" [30] 1000)
  where ?UZD[C]  ?UZD (LPR_ctrl C)



paragraph ‹Basic Rules›

lemma cond_zip_red[simp, φsafe_simp]:
  ?Z True z mapper = z
  ?Z False z mapper = mapper (λx. (x, unspec)) o fst
  unfolding cond_zip_def
  by simp_all

lemma cond_zip2_red[simp, φsafe_simp]:
  ?Z2 True z mapper = z
  ?Z2 False z mapper = mapper (λx. (x, unspec)) (λx. (x, unspec)) o fst
  unfolding cond_zip2_def
  by simp_all

lemma cond_zip_dom_red[simp, φsafe_simp]:
  ?ZD True D D' R' = D
  ?ZD False D D' R' = {x. a. a  D' (fst x)  (a, unspec)  R' (fst x)}
  unfolding cond_zip_dom_def
  by simp_all

lemma cond_zip_dom2_red[simp, φsafe_simp]:
  ?ZD2 True D D'1 D'2 R'1 R'2 = D
  ?ZD2 False D D'1 D'2 R'1 R'2 =
            {x. (a. a  D'1 (fst x)  (a, unspec)  R'1 (fst x)) 
                (a. a  D'2 (fst x)  (a, unspec)  R'2 (fst x)) }
  unfolding cond_zip_dom2_def
  by simp_all

lemma cond_unzip_red[simp, φsafe_simp]:
  ?UZ True uz m = uz
  ?UZ False uz m x = (m fst x, unspec)
  unfolding cond_unzip_def
  by simp_all

lemma cond_unzip[simp, φsafe_simp]:
  fst (uz x) = m fst x
 fst (?UZ flag uz m x) = m fst x
  unfolding cond_unzip_def
  by clarsimp

lemma cond_unzip_dom_red[simp, φsafe_simp]:
  ?UZD True D1 D2 R' = D1
  ?UZD False D1 D2 R' = {x. (a,b)  D2 x. a  R' x}
  unfolding cond_unzip_dom_def
  by simp_all

lemma cond_unzip_dom_simp[simp, φsafe_simp]:
  ?UZD C UNIV (λ_. {}) R' = UNIV
  ?UZD C UNIV D' (λ_. UNIV) = UNIV
  unfolding cond_unzip_dom_def
  by simp_all

lemma cond_zip_dom_simp[simp, φsafe_simp]:
  ?ZD C UNIV (λ_. {}) R' = UNIV
  ?ZD C UNIV D' (λ_. UNIV) = UNIV
  x  ?ZD C D D' (λ_. UNIV)  (C  x  D)
  x  ?ZD C D (λ_. {}) R'  (C  x  D)
  unfolding cond_zip_dom_def
  by simp_all

lemma cond_zip_dom2_simp[simp, φsafe_simp]:
  ?ZD2 C UNIV (λ_. {}) (λ_. {}) R'1 R'2 = UNIV
  ?ZD2 C UNIV D'1 D'2 (λ_. UNIV) (λ_. UNIV) = UNIV
  x  ?ZD2 C D D'1 D'2 (λ_. UNIV) (λ_. UNIV)  (C  x  D)
  x  ?ZD2 C D (λ_. {}) (λ_. {}) R'1 R'2  (C  x  D)
  unfolding cond_zip_dom2_def
  by simp_all


subsubsection ‹Separatable Mapping› ― ‹those used in transformation mapper›

definition separatable_unzip
  where separatable_unzip z uz Du m m1 m2 f g 
          (xDu. z (map_prod (m1 f) (m2 g) (uz x)) = m (map_prod f g) x)

definition separatable_cond_unzip
  where separatable_cond_unzip C z uz Du m m1 m2 f g 
          ((¬C  g = (λ_. unspec))  separatable_unzip z uz Du m m1 m2 f g)

definition separatable_zip
  where separatable_zip uz z Dz m m1 m2 f g 
          (xDz. uz (m (map_prod f g) (z x)) = map_prod (m1 f) (m2 g) x)

definition separatable_cond_zip
  where separatable_cond_zip C uz z Dz m m1 m2 f g 
          ((¬C  g = (λ_. unspec))  separatable_zip uz z Dz m m1 m2 f g)


definition compositional_mapper
  where compositional_mapper m1 m2 m3 D f g 
          (x  D. m1 f (m2 g x) = m3 (f o g) x)

definition domain_of_inner_map
  where domain_of_inner_map mapper Di 
          (f g x. (a  Di x. f a = g a)  mapper f x = mapper g x)

definition domain_by_mapper
  where domain_by_mapper D' m D f Dx  (xDx. D' (m f x)  f ` D x)

definition separatable_module_zip
  where separatable_module_zip flag d a b c uz' z' uz z D fb fc fd fa 
            (x. D x ((fb f fc o uz b c o z d a) x) 
                 (if flag then dabc_equation d a b c else dabc_equation b c d a) 
                 (uz' d a o z' b c o fb f fc o uz b c o z d a) x = (fd f fa) x)

definition module_mapper1ε
  where module_mapper1ε ε eε iε DεE DεI D f f'
             (x. D x  iε (f (eε x)) = f' x  DεE x  DεI (f (eε x)) )

definition module_mapper22
  where module_mapper22 flag d a b c sp' jn' sp jn Dsp' Djn' Dsp Djn DM fc fb fa fd 
    (x. DM x 
         (if flag then dabc_equation d a b c else dabc_equation b c d a) 
         (let (xa,xd) = x
            ; (xc,xb) = sp c b (jn a d (xa,xd))
            ; (yc,yb) = (fc xc, fb xb)
            ; (ya,yd) = sp' a d (jn' c b (yc,yb))
           in (ya,yd) = (fa xa, fd xd) 
              Djn a d (xa,xd) 
              Dsp c b (jn a d (xa,xd)) 
              Djn' c b (yc,yb) 
              Dsp' a d (jn' c b (yc,yb))
))


definition module_mapper13C
  where module_mapper13C Cc Cd d a da c sp jn Dsp Djn D fd fa fc f g 
    (x. D x 
         ?+ True da = ?+ Cd d + ?+ True a  (Cc  da ##+ c)  (Cd  d ##+ a) 
         (let (xa,xd,xc) = x
            ; y = f (?jR Cc (jn da c) (?jL Cd (jn d a) (xd, xa), xc))
            ; (yda,yc) = ?sR Cc (sp da c) y
            ; (yd,ya) = ?sL Cd (sp d a) yda
           in g x = ?jR Cc (jn da c) (?jL Cd (jn d a) (xd, xa), xc) 
              (ya,yc,yd) = (fa xa, fc xc, fd xd) 
              (Cd  Djn d a (xd, xa) 
                      Dsp d a yda) 
              (Cc  Djn da c (?jL Cd (jn d a) (xd, xa), xc) 
                      Dsp da c y)))


definition module_mapper13
  where module_mapper13 d a c sp jn Dsp Djn D fd fa fc f g 
    (x. D x 
         d+a ##+ c  d ##+ a 
         (let (xa,xd,xc) = x
            ; y = f (jn (d+a) c (jn d a (xd, xa), xc))
            ; (yda,yc) = sp (d+a) c y
            ; (yd,ya) = sp d a yda
           in g x = jn (d+a) c (jn d a (xd, xa), xc) 
              (ya,yc,yd) = (fa xa, fc xc, fd xd) 
              Djn d a (xd, xa)  Dsp d a yda 
              Djn (d+a) c (jn d a (xd, xa), xc)  Dsp (d+a) c y))

definition module_mapper12L
  where module_mapper12L d a sp jn Dsp Djn D fd fa f 
    (x. D x 
         d ##+ a 
         (let (xd,xa) = x
            ; y = f (jn d a (xd,xa))
            ; (yd,ya) = sp d a y
           in (yd,ya) = (fd xd, fa xa) 
              Djn d a (xd,xa)  Dsp d a y))

definition module_mapper12R
  where module_mapper12R a c sp jn Dsp Djn D fa fc f 
    (x. D x 
         a ##+ c 
         (let (xa,xc) = x
            ; y = f (jn a c (xa, xc))
            ; (ya,yc) = sp a c y
           in (ya,yc) = (fa xa, fc xc)  Djn a c (xa, xc)  Dsp a c y))

definition module_mapper31C
  where module_mapper31C Cc Cd c b db d sp jn Dsp Djn D fc f fd f' g 
    (x. D x 
         (?+ True db = ?+ Cd d + ?+ True b)  (Cc  db ##+ c)  (Cd  d ##+ b) 
             (let (xdb, xc) = ?sR Cc (sp db c) x
                ; (xd, xb) = ?sL Cd (sp d b) xdb
               in g x = (xd, xb, xc) 
                  (((?jR Cc (jn db c) o apfst (?jL Cd (jn d b))) o
                    ((fd f f) f fc) o
                    (apfst (?sL Cd (sp d b)) o ?sR Cc (sp db c))) x = f' x) 
                  (Cd  Djn d b (fd xd, f xb)  Dsp d b xdb) 
                  (Cc  Djn db c (?jL Cd (jn d b) (fd xd, f xb), fc xc) 
                          Dsp db c x)))

definition module_mapper31
  where module_mapper31 c b d sp jn Dsp Djn D fc f fd f' g 
    (x. D x  (let (xdb, xc) = sp (d+b) c x
                    ; (xd, xb) = sp d b xdb
                   in g x = (xd, xb, xc) 
                      (((jn (d+b) c o apfst (jn d b)) o
                        ((fd f f) f fc) o
                        (apfst (sp d b) o sp (d+b) c)) x = f' x) 
                      Djn d b (fd xd, f xb)  Dsp d b xdb 
                      Djn (d+b) c (jn d b (fd xd, f xb), fc xc) 
                      Dsp (d+b) c x))

definition module_mapper21R
  where module_mapper21R b c sp jn Dsp Djn D fc f f' 
    (x. D x 
         b ##+ c 
         (let (xb, xc) = sp b c x
           in ((jn b c o f f fc o sp b c) x = f' x) 
              Djn b c (f xb, fc xc) 
              Dsp b c x))

definition module_mapper21L
  where module_mapper21L b d sp jn Dsp Djn D f fd f' 
    (x. D x 
         d ##+ b 
        (let (xd, xb) = sp d b x
          in ((jn d b o fd f f o sp d b) x = f' x) 
             Djn d b (fd xd, f xb)  Dsp d b x))

definition module_mapper3εC
  where module_mapper3εC Cc Cd c ε  d sp jn eε iε DεE DεI Dsp Djn D fc f fd f' g 
    (x. D x 
         (?+ True  = ?+ Cd d + ?+ True ε)  (Cc   ##+ c)  (Cd  d ##+ ε) 
         (let (xdε, xc) = ?sR Cc (sp  c) x
            ; (xd, xε) = ?sL Cd (sp d ε) xdε
           in g x = (xd, eε xε, xc) 
              (((?jR Cc (jn  c) o apfst (?jL Cd (jn d ε))) o
                ((fd f (iε o f o eε)) f fc) o
                (apfst (?sL Cd (sp d ε)) o ?sR Cc (sp  c))) x = f' x) 
              DεE xε  DεI (f (eε xε)) 
              (Cd  Djn d ε (fd xd, iε (f (eε xε)))  Dsp d ε xdε) 
              (Cc  Djn  c (?jL Cd (jn d ε) (fd xd, iε (f (eε xε))), fc xc) 
                      Dsp  c x)))

definition module_mapper3ε
  where module_mapper3ε c ε d sp jn eε iε DεE DεI Dsp Djn D fc f fd f' g 
    (x. D x  (let (xdε, xc) = sp (d+ε) c x
                    ; (xd, xε) = sp d ε xdε
                   in g x = (xd, eε xε, xc) 
                      (((jn (d+ε) c o apfst (jn d ε)) o
                        ((fd f (iε o f o eε)) f fc) o
                        (apfst (sp d ε) o sp (d+ε) c)) x = f' x) 
                      DεE xε  DεI (f (eε xε)) 
                      Djn d ε (fd xd, iε (f (eε xε)))  Dsp d ε xdε 
                      Djn (d+ε) c (jn d ε (fd xd, iε (f (eε xε))), fc xc) 
                      Dsp (d+ε) c x))

definition module_mapper2εR
  where module_mapper2εR c ε sp jn eε iε DεE DεI Dsp Djn D fc f f' g 
    (x. D x  (let (xε, xc) = sp ε c x
                   in g x = (eε xε, xc) 
                      ((jn ε c o (iε o f o eε) f fc o sp ε c) x = f' x) 
                      DεE xε  DεI (f (eε xε)) 
                      Djn ε c (iε (f (eε xε)), fc xc) 
                      Dsp ε c x))

definition module_mapper2εL
  where module_mapper2εL ε d sp jn eε iε DεE DεI Dsp Djn D f fd f' g 
    (x. D x 
         d ##+ ε 
         (let (xd, xε) = sp d ε x
           in g x = (xd, eε xε) 
              ((jn d ε o fd f (iε o f o eε) o sp d ε) x = f' x) 
              DεE xε  DεI (f (eε xε)) 
              Djn d ε (fd xd, iε (f (eε xε)))  Dsp d ε x))




paragraph ‹Convention›

φreasoner_group separatable_unzip__all = (1000, [1, 3000]) for separatable_unzip z uz Du m m1 m2 f g
      ‹If and how could a pairwise separated mapping ‹f ⊕f g› that is applied on an unzipped structure
       ‹F(T∗U)› over some pair data ‹T∗U›, be represneted as element-wise mapping over the original structure.›
  and separatable_unzip = (1000, [1000,1030]) in separatable_unzip__all ‹default group›

  and separatable_zip__all = (1000, [1,3000]) for separatable_zip uz z Dz m m1 m2 f g
      ‹If and how could an element-wise mapping ‹m (f ⊕f g)› of pairwisely separated element mapping ‹f ⊕f g›
       that is applied on the zip of two structure ‹F(T)› and ‹F(U)›, be separated to two mappings
       ‹m1› and ‹m2› over ‹F(T)› and ‹F(U)› respectively›
  and separatable_zip = (1000, [1000,1030]) in separatable_zip__all ‹default group›
  and separatable_zip__norm = (2000, [2000,2100]) in separatable_zip__all
      ‹normalization›

  and compositional_mapper__all = (1000, [1, 3000]) for compositional_mapper m1 m2 m3 D f g ‹›
  and compositional_mapper = (1000, [1000,1030]) in compositional_mapper__all ‹›

  and domain_of_inner_map__all = (1000, [1, 3000]) for domain_of_inner_map mapper Di ‹›
  and domain_of_inner_map = (1000, [1000,1030]) in domain_of_inner_map__all ‹›

  and separatable_module_zip__all = (1000, [1, 3000])
      for (separatable_module_zip flag d a b c uz' z' uz z D f g f' g')
      ‹separatable zip and unzip operations of a module φ-type›
  and separatable_module_zip = (1000, [1000,1030]) in separatable_module_zip__all
      ‹the default group›

  and module_mapper__all = (1000, [1, 3000])
      for (module_mapper3εC Cc Cd c ε  d sp jn eε iε DεE DεI Dsp Djn D fc f fd f' g,
           module_mapper3ε c ε d sp jn eε iε DεE DεI Dsp Djn D fc f fd f' g,
           module_mapper2εR c ε sp jn eε iε DεE DεI Dsp Djn D fc f f' g,
           module_mapper2εL ε d sp jn eε iε DεE DεI Dsp Djn D f fd f' g,
           module_mapper13C Cc Cd d a da c sp jn Dsp Djn D fd fa fc f g,
           module_mapper12L d a sp jn Dsp Djn D fd fa f,
           module_mapper31C Cc Cd c b db d sp jn Dsp Djn D fc f fd f' g,
           module_mapper21L b d sp jn Dsp Djn D f fd f')
      ‹transformation mappers of module φ-types›
  and module_mapper = (1000, [1000, 1030]) in module_mapper__all
      ‹the default group›
  and module_mapper_default = (10,[10,30]) in module_mapper__all
      ‹default rules›
  and module_mapper_syserr = (0,[0,0]) < module_mapper__all
      ‹sys error›

declare [[
  φreason_default_pattern
      domain_by_mapper ?D' ?m ?D ?var_f _  domain_by_mapper ?D' ?m ?D _ _ (100)
  and separatable_unzip ?z ?uz _ ?m _ _ ?var_f ?var_g 
      separatable_unzip ?z ?uz _ ?m _ _ _ _                       (100)
  and separatable_cond_unzip ?C ?z ?uz _ ?m _ _ ?var_f ?var_g 
      separatable_cond_unzip ?C ?z ?uz _ ?m _ _ _ _               (100)
  and separatable_zip ?uz ?z _ ?m _ _ ?var_f ?var_g 
      separatable_zip ?uz ?z _ ?m _ _ _ _                         (100)
  and separatable_cond_zip ?C ?uz ?z _ ?m _ _ ?var_f ?var_g 
      separatable_cond_zip ?C ?uz ?z _ ?m _ _ _ _                  (100)
  and compositional_mapper ?m1 ?m2 _ _ ?var_f ?var_g 
      compositional_mapper ?m1 _ _ _ _ _
      compositional_mapper _ ?m2 _ _ _ _                           (100)
  and domain_of_inner_map ?m _  domain_of_inner_map ?m _                                  (100)
  and separatable_module_zip ?flag ?var_d ?var_a ?var_b ?var_c ?uz' ?z' ?uz ?z _ _ _ _ _ 
      separatable_module_zip ?flag _ _ _ _  ?uz' ?z' ?uz ?z _ _ _ _ _                      (100)

  and module_mapper3εC ?Cc ?Cd ?c  ?dε ?d ?sp ?jn ?eε ?iε ?DεE ?DεI ?Dsp ?Djn _ _ _ _ _ _ 
      module_mapper3εC ?Cc ?Cd ?c  ?dε ?d ?sp ?jn ?eε ?iε ?DεE ?DεI ?Dsp ?Djn _ _ _ _ _ _    (100)
  and module_mapper3ε ?c  ?d ?sp ?jn ?eε ?iε ?DεE ?DεI ?Dsp ?Djn _ _ _ _ _ _ 
      module_mapper3ε ?c  ?d ?sp ?jn ?eε ?iε ?DεE ?DεI ?Dsp ?Djn _ _ _ _ _ _              (100)
  and module_mapper2εR ?c  ?sp ?jn ?eε ?iε ?DεE ?DεI ?Dsp ?Djn _ _ _ _ _ 
      module_mapper2εR ?c  ?sp ?jn ?eε ?iε ?DεE ?DεI ?Dsp ?Djn _ _ _ _ _                   (100)
  and module_mapper2εL  ?d ?sp ?jn ?eε ?iε ?DεE ?DεI ?Dsp ?Djn _ _ _ _ _ 
      module_mapper2εL  ?d ?sp ?jn ?eε ?iε ?DεE ?DεI ?Dsp ?Djn _ _ _ _ _                   (100)

  and module_mapper13C ?Cc ?Cd ?d ?a ?da ?c ?sp ?jn ?Dsp ?Djn _ _ _ _ _ _ 
      module_mapper13C ?Cc ?Cd ?d ?a ?da ?c ?sp ?jn ?Dsp ?Djn _ _ _ _ _ _                   (100)
  and module_mapper13 ?d ?a ?c ?sp ?jn ?Dsp ?Djn _ _ _ _ _ _ 
      module_mapper13 ?d ?a ?c ?sp ?jn ?Dsp ?Djn _ _ _ _ _ _                               (100)
  and module_mapper12L ?d ?a ?sp ?jn ?Dsp ?Djn _ _ _ _ 
      module_mapper12L ?d ?a ?sp ?jn ?Dsp ?Djn _ _ _ _                                      (100)
  and module_mapper12R ?a ?c ?sp ?jn ?Dsp ?Djn _ _ _ _ 
      module_mapper12R ?a ?c ?sp ?jn ?Dsp ?Djn _ _ _ _                                      (100)

  and module_mapper31C ?Cc ?Cd ?c ?b ?db ?d ?sp ?jn ?Dsp ?Djn _ _ _ _ _ _ 
      module_mapper31C ?Cc ?Cd ?c ?b ?db ?d ?sp ?jn ?Dsp ?Djn _ _ _ _ _ _                    (100)
  and module_mapper31 ?c ?b ?d ?sp ?jn ?Dsp ?Djn _ _ _ _ _ _ 
      module_mapper31 ?c ?b ?d ?sp ?jn ?Dsp ?Djn _ _ _ _ _ _                                (100)
  and module_mapper21R ?b ?c ?sp ?jn ?Dsp ?Djn _ _ _ _ 
      module_mapper21R ?b ?c ?sp ?jn ?Dsp ?Djn _ _ _ _                                      (100)
  and module_mapper21L ?b ?d ?sp ?jn ?Dsp ?Djn _ _ _ _ 
      module_mapper21L ?b ?d ?sp ?jn ?Dsp ?Djn _ _ _ _                                      (100)


  and domain_by_mapper ?D' ?m ?D ?f ?Ddm 
      ERROR TEXT(‹Malformed Rule› (domain_by_mapper ?D' ?m ?D ?f ?Ddm))            (0)
  and separatable_unzip ?z ?uz ?Du ?m ?m1 ?m2 ?f ?g 
      ERROR TEXT(‹Malformed Rule› (separatable_unzip ?z ?uz ?Du ?m ?m1 ?m2 ?f ?g)) (0)
  and separatable_zip ?uz ?z ?Dz ?m ?m1 ?m2 ?f ?g 
      ERROR TEXT(‹Malformed Rule› (separatable_zip ?uz ?z ?Dz ?m ?m1 ?m2 ?f ?g))  (0)
  and separatable_cond_unzip ?C ?z ?uz ?Du ?m ?m1 ?m2 ?f ?g 
      ERROR TEXT(‹Malformed Rule› (separatable_cond_unzip ?C ?z ?uz ?Du ?m ?m1 ?m2 ?f ?g)) (0)
  and separatable_cond_zip ?C ?uz ?z ?Dz ?m ?m1 ?m2 ?f ?g 
      ERROR TEXT(‹Malformed Rule› (separatable_cond_zip ?C ?uz ?z ?Dz ?m ?m1 ?m2 ?f ?g))  (0)
  and compositional_mapper ?m1 ?m2 ?m3 ?D ?f ?g 
      ERROR TEXT(‹Malformed Rule› (compositional_mapper ?m1 ?m2 ?m3 ?D ?f ?g))    (0)
  and domain_of_inner_map ?m ?Di 
      ERROR TEXT(‹Malformed Rule› (domain_of_inner_map ?m ?Di))                   (0)
  and separatable_module_zip ?flag ?d ?a ?b ?c ?uz' ?z' ?uz ?z ?D ?f ?g ?f' ?g' 
      ERROR TEXT(‹Malformed Rule› (separatable_module_zip ?flag ?d ?a ?b ?c ?uz' ?z' ?uz ?z ?D ?f ?g ?f' ?g'))  (0)
,
  φdefault_reasoner_group
      separatable_unzip _ _ _ _ _ _ _ _ : %separatable_unzip  (100)
  and separatable_zip _ _ _ _ _ _ _ _   : %separatable_zip    (100)
  and separatable_cond_unzip _ _ _ _ _ _ _ _ _ : %separatable_unzip  (100)
  and separatable_cond_zip _ _ _ _ _ _ _ _ _   : %separatable_zip    (100)
  and compositional_mapper _ _ _ _ _ _: %compositional_mapper (100)
  and domain_of_inner_map _ _         : %domain_of_inner_map  (100)
  and separatable_module_zip _ _ _ _ _  _ _ _ _ _ _ _ _ _  : %separatable_module_zip (100)
  and module_mapper3εC _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ : %module_mapper (100)
  and module_mapper3ε _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _        : %module_mapper (100)
  and module_mapper2εR _ _ _ _ _ _ _ _ _ _ _ _ _ _ _           : %module_mapper (100)
  and module_mapper2εL _ _ _ _ _ _ _ _ _ _ _ _ _ _ _           : %module_mapper (100)
]]

paragraph ‹Basic Rules›

subparagraph ‹Module Error›

lemma [φreason default %module_mapper_syserr]:
  ERROR TEXT(‹Fail to apply transformation mapper the module of spliter› sp ‹, joiner› jn
               ‹, identity constructor› iε ‹and destructor› eε ‹, you may provide a LPR reasoning rule›
               (module_mapper3ε c ε d sp jn eε iε DεE DεI Dsp Djn D fc f fd f' g) ‹to address the issue.›)
 module_mapper3ε c ε d sp jn eε iε DεE DεI Dsp Djn D fc f fd f' g
  unfolding ERROR_def
  by blast

lemma [φreason default %module_mapper_syserr]:
  ERROR TEXT(‹Fail to apply transformation mapper the module of spliter› sp ‹, joiner› jn
               ‹, identity constructor› iε ‹and destructor› eε ‹, you may provide a LPR reasoning rule›
               (module_mapper2εR c ε sp jn eε iε DεE DεI Dsp Djn D fc f f' g) ‹to address the issue.›)
 module_mapper2εR c ε sp jn eε iε DεE DεI Dsp Djn D fc f f' g
  unfolding ERROR_def
  by blast

lemma [φreason default %module_mapper_syserr]:
  ERROR TEXT(‹Fail to apply transformation mapper the module of spliter› sp ‹, joiner› jn
               ‹, identity constructor› iε ‹and destructor› eε ‹, you may provide a LPR reasoning rule›
               (module_mapper2εL ε d sp jn eε iε DεE DεI Dsp Djn D f fd f' g) ‹to address the issue.›)
 module_mapper2εL ε d sp jn eε iε DεE DεI Dsp Djn D f fd f' g
  unfolding ERROR_def
  by blast

lemma [φreason default %module_mapper_syserr]:
  ERROR TEXT(‹Fail to apply transformation mapper the module of spliter› sp ‹joiner› jn
               ‹, you may provide a LPR reasoning rule›
               (module_mapper13 d a c sp jn Dsp Djn D fd fa fc f g) ‹to address the issue.›)
 module_mapper13 d a c sp jn Dsp Djn D fd fa fc f g
  unfolding ERROR_def
  by blast

lemma [φreason default %module_mapper_syserr]:
  ERROR TEXT(‹Fail to apply transformation mapper the module of spliter› sp ‹joiner› jn
               ‹, you may provide a LPR reasoning rule›
               (module_mapper12L d a sp jn Dsp Djn D fd fa f) ‹to address the issue.›)
 module_mapper12L d a sp jn Dsp Djn D fd fa f
  unfolding ERROR_def
  by blast

lemma [φreason default %module_mapper_syserr]:
  ERROR TEXT(‹Fail to apply transformation mapper the module of spliter› sp ‹joiner› jn
               ‹, you may provide a LPR reasoning rule›
               (module_mapper12R a c sp jn Dsp Djn D fa fc f) ‹to address the issue.›)
 module_mapper12R a c sp jn Dsp Djn D fa fc f
  unfolding ERROR_def
  by blast

lemma [φreason default %module_mapper_syserr]:
  ERROR TEXT(‹Fail to apply transformation mapper the module of spliter› sp ‹joiner› jn
               ‹, you may provide a LPR reasoning rule›
               (module_mapper31 c b d sp jn Dsp Djn D fc f fd f' g) ‹to address the issue.›)
 module_mapper31 c b d sp jn Dsp Djn D fc f fd f' g
  unfolding ERROR_def
  by blast

lemma [φreason default %module_mapper_syserr]:
  ERROR TEXT(‹Fail to apply transformation mapper the module of spliter› sp ‹joiner› jn
               ‹, you may provide a LPR reasoning rule›
               (module_mapper21L b d sp jn Dsp Djn D f fd f') ‹to address the issue.›)
 module_mapper21L b d sp jn Dsp Djn D f fd f'
  unfolding ERROR_def
  by blast

lemma [φreason default %module_mapper_syserr]:
  ERROR TEXT(‹Fail to apply transformation mapper the module of spliter› sp ‹joiner› jn
               ‹, you may provide a LPR reasoning rule›
               (module_mapper21R b c sp jn Dsp Djn D fc f f') ‹to address the issue.›)
 module_mapper21R b c sp jn Dsp Djn D fc f f'
  unfolding ERROR_def
  by blast


subparagraph ‹Module Conversions›

lemma [φreason default %module_mapper_default]:
  module_mapper3ε c ε d sp jn eε iε DεE DεI Dsp Djn D fc f fd f' g
 module_mapper3εC True True c ε  d sp jn eε iε DεE DεI Dsp Djn D fc f fd f' g
  unfolding module_mapper3εC_def module_mapper3ε_def
  by simp

lemma [φreason default %module_mapper_default]:
  module_mapper2εR c ε sp jn eε iε DεE DεI Dsp Djn D fc f f' g
 module_mapper3εC True False c ε  d sp jn eε iε DεE DεI Dsp Djn D fc f fd f'
                    (λx. case g x of (ε,c)  (unspec,ε,c))
  unfolding module_mapper3εC_def module_mapper2εR_def
  by clarsimp fastforce

lemma [φreason default %module_mapper_default]:
  module_mapper2εL ε d sp jn eε iε DεE DεI Dsp Djn D f fd f' g
 module_mapper3εC False True c ε  d sp jn eε iε DεE DεI Dsp Djn D fc f fd f'
                    (λx. case g x of (d,ε)  (d,ε,unspec))
  unfolding module_mapper3εC_def module_mapper2εL_def
  by clarsimp fastforce

lemma [φreason default %module_mapper_default]:
  𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 ε = 
 module_mapper1ε ε eε iε DεE DεI D f f'
 module_mapper3εC False False c ε  d sp jn eε iε DεE DεI Dsp Djn D fc f fd f'
                    (λx. (unspec, eε x, unspec))
  unfolding module_mapper3εC_def module_mapper1ε_def 𝗋Guard_def Premise_def
  by simp

lemma [φreason default %module_mapper_default]:
  module_mapper13 d a c sp jn Dsp Djn D fd fa fc f g
 module_mapper13C True True d a da c sp jn Dsp Djn D fd fa fc f g
  unfolding module_mapper13C_def module_mapper13_def
  by clarsimp

lemma [φreason default %module_mapper_default]:
  module_mapper12L d a sp jn Dsp Djn D fd fa f
 module_mapper13C False True d a da c sp jn Dsp Djn
                    (λ(xa,xd,xc). D (xd,xa)) fd fa (λ_. unspec) f (λ(xa,xd,xc). jn d a (xd,xa))
  unfolding module_mapper13C_def module_mapper12L_def Let_def
  by clarsimp fastforce

lemma [φreason default %module_mapper_default]:
  module_mapper12R a c sp jn Dsp Djn D fa fc f
 module_mapper13C True False d a da c sp jn Dsp Djn
                    (λ(xa,xd,xc). D (xa,xc)) (λ_. unspec) fa fc f (λ(xa,xd,xc). jn a c (xa,xc))
  unfolding module_mapper13C_def module_mapper12R_def Let_def
  by clarsimp fastforce

lemma [φreason default %module_mapper_default]:
  module_mapper31 c b d sp jn Dsp Djn D fc f fd f' g
 module_mapper31C True True c b db d sp jn Dsp Djn D fc f fd f' g
  unfolding module_mapper31_def module_mapper31C_def
  by clarsimp

lemma [φreason default %module_mapper_default]:
  module_mapper21L b d sp jn Dsp Djn D f fd f'
 module_mapper31C False True c b db d sp jn Dsp Djn D fc f fd f'
                    (λx. case sp d b x of (xd,xb)  (xd, xb, unspec))
  unfolding module_mapper21L_def module_mapper31C_def
  by clarsimp fastforce

lemma [φreason default %module_mapper_default]:
  module_mapper21R b c sp jn Dsp Djn D fc f f'
 module_mapper31C True False c b db d sp jn Dsp Djn D fc f fd f'
                    (λx. case sp b c x of (xb, xc)  (unspec, xb, xc))
  unfolding module_mapper31C_def module_mapper21R_def
  by clarsimp fastforce

lemma [φreason default %module_mapper_default]:
  𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 b = db
 module_mapper31C False False c b db d sp jn Dsp Djn (λ_. True) fc f fd f
                    (λx. (unspec, x, unspec))
  unfolding module_mapper31C_def module_mapper21R_def
  by clarsimp


paragraph ‹Instances›

subparagraph ‹Identity Mappers›

lemma [φreason add]:
  separatable_unzip (λx. x) (λx. x) UNIV (λf. f) (λf. f) (λf. f) g r
  unfolding separatable_unzip_def
  by simp

lemma [φreason add]:
  separatable_zip (λx. x) (λx. x) UNIV (λf. f) (λf. f) (λf. f) f g
  unfolding separatable_zip_def
  by simp

lemma [φreason add]:
  compositional_mapper (λf. f) (λf. f) (λf. f) UNIV f g
  unfolding compositional_mapper_def
  by simp

lemma [φreason add]:
  domain_of_inner_map (λf. f) (λx. {x})
  unfolding domain_of_inner_map_def
  by simp

lemma [φreason add]:
  domain_by_mapper (λx. {x}) (λf. f) (λx. {x}) f UNIV
  unfolding domain_by_mapper_def
  by clarsimp


subparagraph ‹Conditioned›

lemma [φreason %separatable_zip__norm]:
  separatable_cond_unzip (LPR_ctrl C) (?Z (LPR_ctrl C) z mZ) (?UZ (LPR_ctrl C) uz mU) DU' m mf mg f g
 separatable_cond_unzip C (?Z (LPR_ctrl C) z mZ) (?UZ (LPR_ctrl C) uz mU) DU' m mf mg f g
  unfolding LPR_ctrl_def .

lemma [φreason %separatable_zip__norm]:
  separatable_cond_zip (LPR_ctrl C) (?UZ (LPR_ctrl C) uz mU) (?Z (LPR_ctrl C) z mZ) DU' m mf mg f g
 separatable_cond_zip C (?UZ (LPR_ctrl C) uz mU) (?Z (LPR_ctrl C) z mZ) DU' m mf mg f g
  unfolding LPR_ctrl_def .

lemma [φreason add]:
  𝗀𝗎𝖺𝗋𝖽 separatable_unzip z uz DU m mf mg f g 𝗋
          compositional_mapper mf mU m2 Dm f fst 𝗋
          compositional_mapper mZ m2 m Dm2 (λx. (x, unspec)) (f o fst)
 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φinstantiation] DU' : {x. if C then x  DU else x  Dm  Dm2}
 separatable_cond_unzip C (?Z C z mZ) (?UZ C uz mU) DU' m mf (?M C mg) f g
  unfolding 𝗋Guard_def compositional_mapper_def Ant_Seq_def
            separatable_unzip_def separatable_cond_unzip_def Simplify_def
  by (cases C; clarsimp; metis prod.map_beta)

lemma [φreason add]:
  𝗀𝗎𝖺𝗋𝖽 separatable_zip uz z DU m mf mg f g 𝗋
          compositional_mapper m mZ m2 Dm (f f (λ_. unspec)) (λx. (x, unspec)) 𝗋
          compositional_mapper mU m2 mf Dm2 fst (λx. (f x, unspec))
 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φinstantiation] DU' : {x. if C then x  DU else fst x  Dm  Dm2}
 separatable_cond_zip C (?UZ C uz mU) (?Z C z mZ) DU' m mf (?M C mg) f g
  unfolding 𝗋Guard_def compositional_mapper_def Ant_Seq_def
            separatable_zip_def separatable_cond_zip_def Simplify_def
  by (cases C; clarsimp)


subparagraph ‹List›

lemma [φreason for module_mapper1ε  hd (λx. [x]) (λl. length l = _) (λ_. True) _ _ _]:
  𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 one = 1 
 module_mapper1ε one' hd (λx. [x]) (λl. length l = one) (λ_. True) (λl. length l = 1) f (map f)
  unfolding module_mapper1ε_def 𝗋Guard_def Premise_def
  by (simp, metis Suc_length_conv length_0_conv length_map list.map_sel(1) list.sel(1))


lemma [φreason for
          module_mapper2εR ?c ?j : _
           (λs t x. (take (len_intvl.len s) x, drop (len_intvl.len s) x))
           (λs t (x, y). x @ y) hd (λx. [x])
           (λl. length l = _) (λ_. True)
           (λs t x. length x = len_intvl.len s + len_intvl.len t)
           (λs t (x,y). length x = len_intvl.len s  length y = len_intvl.len t) _ _ _ _ _]:
  𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 one = 1  one' = 1
 module_mapper2εR c j : one
        (λs t x. (take (len_intvl.len s) x, drop (len_intvl.len s) x))
        (λs t (x, y). x @ y) hd
        (λx. [x]) (λl. length l = one') (λ_. True)
        (λs t x. length x = len_intvl.len s + len_intvl.len t)
        (λs t (x, y). length x = len_intvl.len s  length y = len_intvl.len t)
        (λx. length x = 1 + len_intvl.len c  length_preserving_map {drop 1 x} fc)
        fc f
        ( list_upd_map 0 f o sublist_map_R 1 fc )
        (λl. (hd l, drop 1 l))
  unfolding module_mapper2εR_def sublist_map_L_def list_upd_map_def sublist_map_R_def
            length_preserving_map_def 𝗋Guard_def Premise_def
  by (auto simp add: hd_drop_conv_nth nth_append upd_conv_take_nth_drop hd_conv_nth)

lemma [φreason for
          module_mapper2εL ?j : _ ?d
           (λs t x. (take (len_intvl.len s) x, drop (len_intvl.len s) x))
           (λs t (x,y). x @ y) hd (λx. [x])
           (λl. length l = _) (λ_. True)
           (λs t x. length x = len_intvl.len s + len_intvl.len t)
           (λs t (x,y). length x = len_intvl.len s  length y = len_intvl.len t) _ _ _ _ _]:
  𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 one = 1  one' = 1
 module_mapper2εL j : one d
    (λs t x. (take (len_intvl.len s) x, drop (len_intvl.len s) x))
    (λs t (x,y). x @ y) hd
    (λx. [x]) (λl. length l = one') (λ_. True)
    (λs t x. length x = len_intvl.len s + len_intvl.len t)
    (λs t (x,y). length x = len_intvl.len s  length y = len_intvl.len t)
    (λx. length x = len_intvl.len d + 1  length_preserving_map {take (len_intvl.len d) x} fd)
    f fd
    ( sublist_map_L (len_intvl.len d) fd o list_upd_map (len_intvl.len d) f )
    (λl. (take (len_intvl.len d) l, l ! (len_intvl.len d)))
  unfolding module_mapper2εL_def sublist_map_L_def list_upd_map_def sublist_map_R_def
            length_preserving_map_def Premise_def 𝗋Guard_def
  by (auto simp add: hd_drop_conv_nth nth_append upd_conv_take_nth_drop)

lemma [φreason for
          module_mapper3ε ?c ?j : _ ?d
           (λs t x. (take (len_intvl.len s) x, drop (len_intvl.len s) x))
           (λs t (x,y). x @ y) hd (λx. [x])
           (λl. length l = _) (λ_. True)
           (λs t x. length x = len_intvl.len s + len_intvl.len t)
           (λs t (x,y). length x = len_intvl.len s  length y = len_intvl.len t) _ _ _ _ _ _]:
  𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 one = 1  one' = 1
 module_mapper3ε c j : one d
     (λs t x. (take (len_intvl.len s) x, drop (len_intvl.len s) x))
     (λs t (x,y). x @ y) hd
     (λx. [x]) (λl. length l = one') (λ_. True)
     (λs t x. length x = len_intvl.len s + len_intvl.len t)
     (λs t (x,y). length x = len_intvl.len s  length y = len_intvl.len t)
     (λx. length x = len_intvl.len d + 1 + len_intvl.len c 
          length_preserving_map {drop (len_intvl.len d + 1) x} fc 
          length_preserving_map {take (len_intvl.len d) x} fd)
     fc f fd
     ( sublist_map_L (len_intvl.len d) fd
     o list_upd_map (len_intvl.len d) f
     o sublist_map_R (len_intvl.len d+1) fc )
     (λl. (take (len_intvl.len d) l, l ! (len_intvl.len d), drop (len_intvl.len d + 1) l))
  unfolding module_mapper3ε_def sublist_map_L_def list_upd_map_def sublist_map_R_def
            length_preserving_map_def Premise_def 𝗋Guard_def
  by (auto simp add: hd_drop_conv_nth nth_append upd_conv_take_nth_drop)




subsection ‹Definitions›

subsubsection ‹Transformations›

paragraph ‹Variant Functor›

definition Transformation_Functor F1 F2 T U D R mapper 
  (x g. (a  D x. a  T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U 𝗌𝗎𝖻𝗃 b. g a b) 
             (a b. a  D x  g a b  b  R x) 
             (x  F1 T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  F2 U 𝗌𝗎𝖻𝗃 y. mapper g x y))
  ― ‹f1 and d1 make the domain set.

  The definition is given in reasoning-friendly form and should entail, (TODO: verify!)

  definition Transformation_Functor F1 F2 mapper ⟷
    (∀T U r x. (∀x. x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ U 𝗌𝗎𝖻𝗃 y. (x,y) ∈ r) ⟶
               (x ⦂ F1 T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ F2 U 𝗌𝗎𝖻𝗃 y. (x,y) ∈ mapper r))›,
  when D is UNIV

  The nondeterminancy from relation r› can be achieved by embedding ExTyp.

  We strengthen this original definition by allowing the domain of the element transformation to be
  depended on the source object of the functor transformation so that the reasoning can have more
  information about the domain of the element transformation.


  R› constrains the range of the transformation of the inner elements, which will be a proof obligation
      reported to users for each transformation application.
  It is useful especially for dependent data types like a list of even numbers.
  As R› is parameterized by the abstract container x›, by assigning R› to empty set on certain
  invalid abstract containers, it also constraints the domain of abstract containers on which
  the transformation functor is available.

  For general data structures which do not assumes such, tt is usually λ_. ⊤›.
  Our automatic deriver by default assumes it to λ_. ⊤› if no user hint is given.
›

text ‹A transformation functor mapper› is complete iff for a given complete transformation relation
family {gi}›, {mapper gi}› is also complete (the notion of completeness can be extended to relations naturally
by converting a relation as a function to a set).›

(*It seems we have the need to give bifunctor*)

definition Functional_Transformation_Functor :: (('b,'a) φ  ('d,'c) φ)
                                                (('b,'e) φ  ('d,'f) φ)
                                                ('b,'a) φ
                                                ('b,'e) φ
                                                ('c  'a set)
                                                ('c  'e set)
                                                (('a  'e)  ('a  bool)  'c  bool)
                                                (('a  'e)  ('a  bool)  'c  'f)
                                                bool
  where Functional_Transformation_Functor Fa Fb T U D R pred_mapper func_mapper 
            (x f P. (a  D x. a  T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f a  U 𝗐𝗂𝗍𝗁 P a)
                 (a. a  D x  f a  R x)
                 (x  Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 func_mapper f P x  Fb U 𝗐𝗂𝗍𝗁 pred_mapper f P x))

text ‹When the element transformation is applied with a partial function (with P› giving the domain),
  the entire transformation is also a partial function.
  The ‹func_mapper› is usually the functional mapper and the
  ‹pred_mapper› is the predicate mapper of an ADT. An exceptional example is set,
  func_mapperset f P S = { f x |x ∈ S. P x }› and pred_mapperset f P S = ⊤›,
  whose (generalized) algebraic mappers are however set image and set-forall (of its element).

  P› gives the domain of the partial map f›.
  D› gives the domain of the inner elements of the functor.
›


lemma infer_FTF_from_FT:
  Transformation_Functor F1 F2 T U D R mapper
 Object_Equiv (F2 U) eq
 (f P x y. mapper (λa b. b = f a  P a) x y  eq y (fm f P x)  pm f P x)
 Functional_Transformation_Functor F1 F2 T U D R pm fm
  unfolding Functional_Transformation_Functor_def Transformation_Functor_def
            Object_Equiv_def
  apply clarsimp
  subgoal premises prems for x f P
    by (insert prems(1)[THEN spec[where x=x], THEN spec[where x=λa b. b = f a  P a]]
               prems(2-),
        clarsimp simp add: Transformation_def,
        blast) .


paragraph ‹Variant Bi-Functor›

definition Transformation_BiFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 mapper 
  (x g1 g2. (a  D1 x. a  T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U1 𝗌𝗎𝖻𝗃 b. g1 a b) 
            (a  D2 x. a  T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U2 𝗌𝗎𝖻𝗃 b. g2 a b) 
            (a b. a  D1 x  g1 a b  b  R1 x)  (a b. a  D2 x  g2 a b  b  R2 x) 
            (x  Fa T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  Fb U1 U2 𝗌𝗎𝖻𝗃 y. mapper g1 g2 x y))

definition Functional_Transformation_BiFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 pred_mapper func_mapper 
    (x f1 f2 P1 P2. (a  D1 x. a  T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f1 a  U1 𝗐𝗂𝗍𝗁 P1 a)
                 (a  D2 x. a  T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f2 a  U2 𝗐𝗂𝗍𝗁 P2 a)
                 (a. a  D1 x  f1 a  R1 x)  (a. a  D2 x  f2 a  R2 x)
                 (x  Fa T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 func_mapper f1 f2 P1 P2 x  Fb U1 U2 𝗐𝗂𝗍𝗁 pred_mapper f1 f2 P1 P2 x))

lemma infer_biFTF_from_biFT:
  Transformation_BiFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 mapper
 Object_Equiv (Fb U1 U2) eq
 (f1 f2 P1 P2 x y. mapper (λa b. b = f1 a  P1 a) (λa b. b = f2 a  P2 a) x y
                   eq y (fm f1 f2 P1 P2 x)  pm f1 f2 P1 P2 x)
 Functional_Transformation_BiFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 pm fm
  unfolding Functional_Transformation_BiFunctor_def Transformation_BiFunctor_def
            Object_Equiv_def
  apply clarify
  subgoal premises prems for x f1 f2 P1 P2
    by (insert prems(1)[THEN spec[where x=x],
                        THEN spec[where x=λa b. b = f1 a  P1 a],
                        THEN spec[where x=λa b. b = f2 a  P2 a]]
               prems(2-),
        clarsimp simp add: Transformation_def,
        blast) .


paragraph ‹Variant Functor with Parameterization›

definition Transformation_FunctorΛ F1 F2 T U D R mapper 
  (x g. (p. a  D p x. a  T p 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U p 𝗌𝗎𝖻𝗃 b. g p a b) 
             (p a b. a  D p x  g p a b  b  R p x) 
             (x  F1 T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  F2 U 𝗌𝗎𝖻𝗃 y. mapper g x y))

definition Functional_Transformation_FunctorΛ Fa Fb T U D R pred_mapper func_mapper 
            (x f P. (p. a  D p x. a  T p 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f p a  U p 𝗐𝗂𝗍𝗁 P p a)
                 (p a. a  D p x  f p a  R p x)
                 (x  Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 func_mapper f P x  Fb U 𝗐𝗂𝗍𝗁 pred_mapper f P x))

lemma infer_FTFΛ_from_FTΛ:
  Transformation_FunctorΛ F1 F2 T U D R mapper
 Abstract_Domain (F1 T) PT
 Abstract_Domain (F2 U) PU
 Object_Equiv (F2 U) eq
 (f P x y. PT x  PU y  mapper (λp a b. b = f p a  P p a) x y  eq y (fm f P x)  pm f P x)
 Functional_Transformation_FunctorΛ F1 F2 T U D R pm fm
  unfolding Functional_Transformation_FunctorΛ_def Transformation_FunctorΛ_def
            Object_Equiv_def Abstract_Domain_def Action_Tag_def Satisfiable_def 𝗋EIF_def
  apply clarsimp
  subgoal premises prems for x f P
    by (insert prems(1)[THEN spec[where x=x], THEN spec[where x=λp a b. b = f p a  P p a]]
               prems(2-),
        clarsimp simp add: Transformation_def,
        blast) .


paragraph ‹(Contravariant, Variant) Bi-Functor›

definition CV_TrFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 mapper 
  (x g1 g2. (a. (a  U1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  T1 𝗌𝗎𝖻𝗃 b. g1 b a)) 
            (a  D2 x. a  T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U2 𝗌𝗎𝖻𝗃 b. g2 a b) 
            (a b. a  D2 x  g2 a b  b  R2 x) 
            (x  Fa T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  Fb U1 U2 𝗌𝗎𝖻𝗃 y. mapper g1 g2 x y))

definition Fun_CV_TrFunctor Fa Fb T1 T2 U1 U2 D1 D2 FC1 R2 pred_mapper func_mapper 
    (x f1 f2 P1 P2. (a. f1 a  D1 x  (a  U1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f1 a  T1 𝗐𝗂𝗍𝗁 P1 a))
                 (a  D2 x. a  T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f2 a  U2 𝗐𝗂𝗍𝗁 P2 a)
                 FC1 f1 x  (a. a  D2 x  f2 a  R2 x)
                 (x  Fa T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 func_mapper f1 f2 P1 P2 x  Fb U1 U2 𝗐𝗂𝗍𝗁 pred_mapper f1 f2 P1 P2 x))






subsubsection ‹Separation›

definition Object_Sep_HomoI :: ('b::sep_magma, 'a::sep_magma) φ  ('a × 'a) set  bool
  where Object_Sep_HomoI T D  (x y. (x,y)  D  ((x  T) * (y  T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x * y  T 𝗐𝗂𝗍𝗁 x ## y ))

definition Object_Sep_HomoE T  (x y. x ## y  ( (x * y  T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (x  T) * (y  T) ))

definition Separation_HomoI :: (('b::sep_magma_1,'a) φ  ('d::sep_magma_1,'c) φ)
              (('b,'e) φ  ('d,'f) φ)
              (('b, 'a × 'e) φ  ('d,'g) φ)
              ('b,'a) φ  ('b,'e) φ
              ('c × 'f) set  ('c × 'f  'g)  bool
    where Separation_HomoI Ft Fu F3 T U D z 
              (x y. (x,y)  D  ((x,y)  Ft(T)  Fu(U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z (x,y)  F3 (T  U)))

definition Separation_HomoI2 Ft Fu F3 T1 T2 U1 U2 D z 
              (x y. (x,y)  D  ((x,y)  Ft T1 T2  Fu U1 U2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z (x,y)  F3 (T1  U1) (T2  U2) ))

definition Separation_HomoE :: (('b::sep_magma,'a) φ  ('d::sep_magma_1,'c) φ)
               (('b,'e) φ  ('d,'f) φ)
               (('b, 'a × 'e) φ  ('d,'g) φ)
               ('b,'a) φ  ('b,'e) φ  'g set  ('g  'c × 'f)  bool
    where Separation_HomoE Ft Fu F3 T U Du un  ― ‹Does it need a domain constraint?›
              (zDu. z  F3 (T  U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 un z  Ft T  Fu U)

definition Separation_HomoE2 Ft Fu F3 T1 T2 U1 U2 Du un 
              (zDu. z  F3 (T1  U1) (T2  U2) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 un z  Ft T1 T2  Fu U1 U2)


definition Separation_HomoI_Cond :: (('b::sep_magma_1,'a) φ  ('d::sep_magma_1,'c) φ)
          (('b,'e) φ  ('d,'f) φ)
          (('b, 'a × 'e) φ  ('d,'g) φ)
          bool  ('b,'a) φ  ('b,'e) φ
          ('c × 'f) set  ('c × 'f  'g)
          bool
    where Separation_HomoI_Cond Ft Fu F3 CW T U D z 
              (x y. (x,y)  D  ((x,y)  Ft T  ◒[CW] Fu U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z (x,y)  F3 (T  ◒[CW] U)))

definition Separation_HomoI2_Cond Ft Fu F3 CW T1 T2 U1 U2 D z 
              (x y. (x,y)  D  ((x,y)  Ft T1 T2  ◒[CW] Fu U1 U2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z (x,y)  F3 (T1  ◒[CW] U1) (T2  ◒[CW] U2) ))


definition Separation_HomoE_Cond :: (('b::sep_magma_1,'a) φ  ('d::sep_magma_1,'c) φ)
          (('b,'e) φ  ('d,'f) φ)
          (('b, 'a × 'e) φ  ('d,'g) φ)
          bool  ('b,'a) φ  ('b,'e) φ
          'g set  ('g  'c × 'f)  bool
    where Separation_HomoE_Cond Ft Fu F3 CR T U D un 
              (z. z  D  (z  F3 (T  ◒[CR] U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 un z  Ft T  ◒[CR] Fu U))

definition Separation_HomoE2_Cond Ft Fu F3 C T1 T2 U1 U2 D un 
             (z. z  D  (z  F3 (T1  ◒[C] U1) (T2  ◒[C] U2) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 un z  Ft T1 T2  ◒[C] Fu U1 U2 ))



paragraph ‹With Parameter›

definition Separation_HomoΛI Ft Fu F3 T U D z 
              (x y. (x,y)  D  ((x,y)  Ft(T)  Fu(U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z (x,y)  F3 (λp. T p  U p)))

definition Separation_HomoΛE Ft Fu F3 T U Du un 
              (zDu. z  F3 (λp. T p  U p) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 un z  Ft T  Fu U)

definition Separation_HomoΛI_Cond Ft Fu F3 C T U D z 
              (x y. (x,y)  D  ((x,y)  Ft(T)  ◒[C] Fu(U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z (x,y)  F3 (λp. T p  ◒[C] U p)))

definition Separation_HomoΛE_Cond Ft Fu F3 C T U D un 
              (z. z  D  (z  F3 (λp. T p  ◒[C] U p) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 un z  Ft T  ◒[C] Fu U))


subsubsection ‹Semimodule›

text ‹Convention: the domain Dx› of object gives proof obligation but the domain Ds› of scalar is
  a reasoning guard. Recall the reasoning is guided by types, the reasoning should be determined
  only by types, where a proof obligation about the objects are yielded as an outcome.
  Dx› is totally about objects but Ds› is about scalar and scalar is in type-level.
›

definition Module_Zero :: ('s  ('c::one,'a) φ)  's  bool
  where Module_Zero F zero  (x. (x  F zero) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 1)

definition Closed_Module_Zero :: ('s  ('c::one,'a) φ)  's  bool
  where Closed_Module_Zero F zero  (x. (x  F zero) = 1)
  ― ‹It is actually a very strong property particularly when T› is an empty φ-type of empty
      abstract domain. It excludes functional homomorphism like F c T ≡ ψ c ⨾f T›.›

definition Module_OneI :: ('s  ('c,'a) φ)
                             ('c,'a1) φ
                             's  ('a1  bool)  ('a1  'a)  ('a1  bool)
                             bool
  where Module_OneI F T1 one D f P  (x. D x  (x  T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x  F one 𝗐𝗂𝗍𝗁 P x))
  ― ‹Domain information should be given in types. The unit scalar one› belongs to domain info.
      So, the value of one› should be able to be determined solely from T1 and F›, but no x›.›

definition Module_OneE :: ('s  ('c,'a) φ)
                             ('c,'a1) φ
                             's  ('a  bool)  ('a  'a1)  ('a  bool)
                             bool
  where Module_OneE F T1 one D f P  (x. D x  (x  F one 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x  T1 𝗐𝗂𝗍𝗁 P x))

(* no need, as covered by the rule of ‹individual → segment›
definition Semimodule_Cons :: ‹ ('s ⇒ ('cT,'aT) φ ⇒ ('c::sep_magma,'a) φ) ⇒ ('cT,'aT) φ ⇒ ('c,'a1) φ
                             ⇒ ('s ⇒ bool) ⇒ ('s ⇒ 'a1 ⇒ 'a ⇒ bool)
                             ⇒ ('a1 ⇒ 's ⇒ 's) ⇒ ('a1 ⇒ 'a ⇒ 'a)
                             ⇒ bool›
  where ‹Semimodule_Cons F T T1 Ds D incr cons ⟷
            (∀s a x. Ds s ∧ D s a x ⟶ ( (a,x) ⦂ T1 ∗ F s T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 cons a x ⦂ F (incr a s) T ))›
  ― ‹Given a φ-type ‹T1 ≠ F s' T'› not in a semimodule form, how to merge it into an existing semimodule.
      ‹Module_Zero› and ‹Semimodule_Cons› derives ‹Semimodule_Cons››
*)

(*
definition Module_Assoc :: ‹ ('s ⇒ ('c,'a) φ ⇒ ('c,'a) φ)
                                     ⇒ ('c,'a) φ
                                     ⇒ ('s::semigroup_mult ⇒ bool)
                                     ⇒ bool›
  where ‹Module_Assoc F T Ds ⟷ (∀s t. Ds s ∧ Ds t ⟶ F s (F t T) = F (t * s) T)›
  ― ‹Associativity of scalar multiplication›
*)

definition Module_AssocI :: ('ss  ('ct,'at) φ  ('cst,'as_t) φ)
                                      ('st  ('c,'a) φ  ('ct,'at) φ)
                                      ('sc  ('c,'a) φ  ('cst,'ast) φ)
                                      ('c,'a) φ
                                      ('ss  bool)
                                      ('st  bool)
                                      ('ss  'st  'as_t  bool)
                                      ('ss  'st  'sc)
                                      ('ss  'st  'as_t  'ast)
                                      bool
  where Module_AssocI Fs Ft Fc T Ds Dt Dx smul f
       (s t x. Ds s  Dt t  Dx s t x  (x  Fs s (Ft t T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f s t x  Fc (smul s t) T))
  ― ‹An extension overcoming the type limitation of the simple type theory of Isabelle.
      It can cover mul quant›

definition Module_AssocE :: ('ss  ('ct,'at) φ  ('cst,'as_t) φ)
                                      ('st  ('c,'a) φ  ('ct,'at) φ)
                                      ('sc  ('c,'a) φ  ('cst,'ast) φ)
                                      ('c,'a) φ
                                      ('ss  bool)
                                      ('st  bool)
                                      ('ss  'st  'ast  bool)
                                      ('ss  'st  'sc)
                                      ('ss  'st  'ast  'as_t)
                                      bool
  where Module_AssocE Fs Ft Fc T Ds Dt Dx smul f
       (s t x. Ds s  Dt t  Dx s t x  (x  Fc (smul s t) T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f s t x  Fs s (Ft t T)))

text ‹The extended scalar association operator for Finite Multiplicative Quantification is just uncurrying.›

definition Module_AssocΛI :: ('ss  ('ps  ('ct,'at) φ)  ('cst,'as_t) φ)
                                      ('st  ('pt  ('c,'a) φ)  ('ct,'at) φ)
                                      ('sc  ('ps × 'pt  ('c,'a) φ)  ('cst,'ast) φ)
                                      ('ps  'pt  ('c,'a) φ)
                                      ('ss  bool)
                                      ('st  bool)
                                      ('ss  'st  'as_t  bool)
                                      ('ss  'st  'sc)
                                      ('ss  'st  'as_t  'ast)
                                      bool
  where Module_AssocΛI Fs Ft Fc T Ds Dt Dx smul f
       (s t x. Ds s  Dt t  Dx s t x  (x  Fs s (λps. Ft t (T ps)) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f s t x  Fc (smul s t) (case_prod T)))

definition Module_AssocΛE :: ('ss  ('ps  ('ct,'at) φ)  ('cst,'as_t) φ)
                                      ('st  ('pt  ('c,'a) φ)  ('ct,'at) φ)
                                      ('sc  ('ps × 'pt  ('c,'a) φ)  ('cst,'ast) φ)
                                      ('ps × 'pt  ('c,'a) φ)
                                      ('ss  bool)
                                      ('st  bool)
                                      ('ss  'st  'as_t  bool)
                                      ('ss  'st  'sc)
                                      ('ss  'st  'as_t  'ast)
                                      bool
  where Module_AssocΛE Fs Ft Fc T Ds Dt Dx smul f
       (s t x. Ds s  Dt t  Dx s t x  (f s t x  Fc (smul s t) T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x  Fs s (λps. Ft t (λpt. T (ps, pt)))))


definition Module_Distr_HomoZ :: ('s  ('c::sep_magma,'a) φ)
                                     ('s::partial_add_magma  bool)
                                     ('s  's  'a × 'a  bool)
                                     ('s  's  'a × 'a  'a)
                                     bool
  where Module_Distr_HomoZ F Ds Dx z 
            (s t x. Ds s  Ds t  s ##+ t  Dx s t x  (x  F s  F t 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z s t x  F (s + t) ))
  ― ‹The left distributive law (i.e., the distributivity of scalar addition) of a left-module.
      Note the right distributive law (i.e., the distributivity of vector addition) is just the separation homomorphism.
      So, when both of Module_Assoc›, Separation_Homo›, Module_Distr_HomoZ, and
      homomorphism of identity element, are satisfied, it is then a semimodule.
›

definition Module_Distr_HomoZ_rev :: ('s  ('c::sep_magma,'a) φ)
                                         ('s::partial_add_magma  bool)
                                         ('s  's  'a × 'a  bool)
                                         ('s  's  'a × 'a  'a)
                                         ('s  's  'a × 'a  bool)
                                         ('s  's  'a × 'a  'a)
                                         bool
  where Module_Distr_HomoZ_rev F Ds Dx' z' Dx z 
            (Module_Distr_HomoZ F Ds Dx' z' 
            (s t x. Ds s  Ds t  t ##+ s  Dx s t x 
                  (x  F s  F t 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z s t x  F (t + s) )))
  ― ‹Should be only used when assuming non-commutative separation algebra and non-commutative scalar,
      else should use Module_Distr_HomoZ instead, see SDirst_in_comm_sep_implies_rev›
      and SDirst_in_comm_scalar_implies_rev›
  ― ‹Note antecedents of Module_Distr_HomoZ_rev› will not trigger the template instantiation, as
       they are not template parameters but normal reasoning goals.
      You may add a useless premise Module_Distr_HomoZ in your rule serving as a template parameter,
        as all instances of Module_Distr_HomoZ_rev› are deduced from Module_Distr_HomoZ.
      It is not a template parameter because one Module_Distr_HomoZ may deduce multiple
        Module_Distr_HomoZ_rev› depending on if the scalar or the separation algebra is commutative,
        and we really don't want multiple instantiations of a template parameter because the number
        of instantiations is multiplied!›


definition Module_Distr_HomoS :: ('s  ('c::sep_magma,'a) φ)
                                     ('s::partial_add_magma  bool)
                                     ('s  's  'a  bool)
                                     ('s  's  'a  'a × 'a)
                                     bool
  where Module_Distr_HomoS F Ds Dx uz 
            (s t x. Ds s  Ds t  s ##+ t  Dx s t x 
                (x  F (s + t) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 uz s t x  F s  F t ))

definition Module_Distr_HomoS_rev :: ('s  ('c::sep_magma,'a) φ)
                                         ('s  's  'a  bool)
                                         ('s  's  'a  'a × 'a)
                                         ('s::partial_add_magma  bool)
                                         ('s  's  'a  bool)
                                         ('s  's  'a  'a × 'a)
                                         bool
  where Module_Distr_HomoS_rev F Dx' uz' Ds Dx uz 
            (Module_Distr_HomoS F Ds Dx' uz' 
            (s t x. Ds s  Ds t  t ##+ s  Dx s t x 
                (x  F (t + s) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 uz s t x  F s  F t )))
  ―‹Also not a template parameter, see Module_Distr_HomoZ_rev›

definition Semimodule_No_SDistr :: 'a  bool
  where Semimodule_No_SDistr F  True
  ― ‹tagging the φ-type operator F› has no scalar associativity, so hinting the use of the rules
      which are unsafe for scalar associativity.›


subsubsection ‹Commutativity between φ-Type Operators›

text Separation_Homo› is a special case of the commutativity to ∗›.›

text ‹The properties are all given in relationform, while functional version can be obtained by
  and should be represented in termembedded_func which prevents over-simplification
  (e.g., when P = (λx. True)›)›

paragraph ‹Unary-to-Unary›

definition Tyops_Commute :: (('cG,'aG) φ  ('c,'a) φ)
                            (('cT,'aT) φ  ('cF,'aF) φ)
                            (('cT,'aT) φ  ('cG,'aG) φ)
                            (('cF,'aF) φ  ('c,'b) φ)
                            ('cT,'aT) φ
                            ('a  bool)
                            ('a  'b  bool)
                            bool
  where Tyops_Commute F F' G G' T D r 
            (x. D x  (x  F (G T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  G' (F' T) 𝗌𝗎𝖻𝗃 y. r x y))


paragraph ‹Unary-to-Binary›

definition Tyops_Commute1_2 :: (('cG,'aG) φ  ('c,'a) φ)
                              (('cT,'aT) φ  ('cFT,'aFT) φ)
                              (('cU,'aU) φ  ('cFU,'aFU) φ)
                              (('cT,'aT) φ  ('cU,'aU) φ  ('cG,'aG) φ)
                              (('cFT,'aFT) φ  ('cFU,'aFU) φ  ('c,'b) φ)
                              ('cT,'aT) φ
                              ('cU,'aU) φ
                              ('a  bool)
                              ('a  'b  bool)
                              bool
  where Tyops_Commute1_2 F F'T F'U G G' T U D r 
            (x. D x  (x  F (G T U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  G' (F'T T) (F'U U) 𝗌𝗎𝖻𝗃 y. r x y))

paragraph ‹Binary-to-Unary›

definition Tyops_Commute2_1 :: (('cG,'aG) φ  ('c,'a) φ)
                               (('cT,'aT) φ  ('cFT,'aFT) φ)
                               (('cU,'aU) φ  ('cFU,'aFU) φ)
                               (('cT,'aT) φ  ('cU,'aU) φ  ('cG,'aG) φ)
                               (('cFT,'aFT) φ  ('cFU,'aFU) φ  ('c,'b) φ)
                               ('cT,'aT) φ
                               ('cU,'aU) φ
                               ('b  bool)
                               ('b  'a  bool)
                               bool
  where Tyops_Commute2_1 F F'T F'U G G' T U D r 
            (x. D x  (x  G' (F'T T) (F'U U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  F (G T U) 𝗌𝗎𝖻𝗃 y. r x y))

paragraph ‹Over Parameterized Types›

definition Tyops_CommuteΛI :: (('cG,'aG) φ  ('c,'a) φ)
                              (('cT,'aT) φ  ('cF,'aF) φ)
                              (('p  ('cT,'aT) φ)  ('cG,'aG) φ)
                              (('p  ('cF,'aF) φ)  ('c,'b) φ)
                              ('p  ('cT,'aT) φ)
                              ('a  bool)
                              ('a  'b  bool)
                              bool
  where Tyops_CommuteΛI F F' G G' T D r 
            (x. D x  (x  F (G T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  G' (λp. F' (T p)) 𝗌𝗎𝖻𝗃 y. r x y))

definition Tyops_CommuteΛE :: (('p  ('cG,'aG) φ)  ('c,'a) φ)
                              (('p  ('cT,'aT) φ)  ('cF,'aF) φ)
                              (('cT,'aT) φ  ('cG,'aG) φ)
                              (('cF,'aF) φ  ('c,'b) φ)
                              ('p  ('cT,'aT) φ)
                              ('a  bool)
                              ('a  'b  bool)
                              bool
  where Tyops_CommuteΛE F F' G G' T D r 
            (x. D x  (x  F (λp. G (T p)) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  G' (F' T) 𝗌𝗎𝖻𝗃 y. r x y))


subsection ‹Conventions›

subsubsection ‹General Groups of Properties›

φreasoner_group φtype_algebra_all_properties = (100, [0,4000]) for _
    ‹The universe group containing every sort of φ-type algebraic properties›
 and φTA_system_bottom = (1, [0,19]) for _ in φtype_algebra_all_properties
    ‹Systematic rules of φ-type algebraic properties, of the lowest priority.›
 and φTA_fallback_lattice = (14, [10,19]) for _ in φTA_system_bottom
    ‹Rules of φ-type algebraic forming a lattice giving fallbacks from weak properties to strong properties›
 and φtype_algebra_properties = (100, [20, 3800]) for _ in φtype_algebra_all_properties
                                                          and > φTA_system_bottom
    ‹User rules of φ-type algebraic properties›
 and φTA_property = (1000, [1000, 1030]) for _ in φtype_algebra_properties
    ‹Cutting rules›
 and φTA_derived_properties = (50, [50,50]) for _ in φtype_algebra_properties
    ‹Automatically derived properties.›
 and φTA_varify_out = (3900, [3900,3900]) for _ in φtype_algebra_all_properties and > φtype_algebra_properties
    ‹Systematic rules of φ-type algebraic properties that varifies OUT arguments that are not varibales›
 and φTA_commutativity = (100, [20, 3800]) for (Tyops_Commute F F' G G' T D r,
                                                 Tyops_Commute1_2 F F'T F'U G G' T U D r,
                                                 Tyops_Commute2_1 F F'T F'U G G' T U D r)
                                            in φtype_algebra_properties
    ‹commutativities›
 and φTA_commutativity_default = (100, [100, 100]) in φTA_commutativity
    ‹rules not assigned with a specific priority and group›
 and φTA_derived_commutativity = (50,[50,50]) in φTA_commutativity and in φTA_derived_properties
    ‹commutativities. Note, because Tyops_Commute is also a tempalte property which may trigger
     instantiation of a lot templates. The deriviation should be prudent, which may provide templates
     to allow users to manually instantiation but registering to the φ-LPR only when the instantiated
     commutativity is certainly correct, because user overridings cannot override the rules
     instantiated by the derived commutativity to be overrided. ›

subsubsection ‹Groups for Specific Properties›

φreasoner_group Object_Sep_Homo_functor = (50, [50,50]) for (Object_Sep_HomoI T D, Object_Sep_HomoE T)
                                                         in φtype_algebra_properties
    ‹Object_Sep_Homo for functors›

subsubsection ‹Derived Rules›

φreasoner_group deriving_local_rules = (200, [180,220]) for _ > default
    ‹Local reasoning rules such as those extracted from induction hypotheses used during deriving.›

 and ToA_derived_one_to_one_functor = (70, [70,70]) for x  F(T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f(x)  F(U) in ToA_derived
    ‹Derived transformation in form ‹x ⦂ F(T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f(x) ⦂ F(U)›, of a high priority as this is what
     should be attempted in reasoning.›
 and To_ToA_derived_Tr_functor = (60, [60,60]) for x  T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  U 𝗌𝗎𝖻𝗃 y. r x y 𝗐𝗂𝗍𝗁 P @tag to U
                                                in To_ToA_derived
    ‹Derived To-Transformation rules for transformation functor›
 and To_ToA_derived_Tr_functor_fuzzy = (55, [55,55]) for x  T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  U 𝗌𝗎𝖻𝗃 y. r x y 𝗐𝗂𝗍𝗁 P @tag to U
                                                in To_ToA_derived and < To_ToA_derived_Tr_functor
    ‹when the annotated target φ-type is in the element algebra but not the container›
 and To_ToA_derived_to_raw = (60, [60,60]) for x  T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  Itself 𝗌𝗎𝖻𝗃 y. r x y 𝗐𝗂𝗍𝗁 P @tag to Itself
                                            in To_ToA_derived
    ‹Derived To-Transformation openning down the raw concrete representation›
 and φsimp_derived_Tr_functor = (40, [40,45]) for X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒜simp
                                               in φsimp_derived
    ‹Derived transformation-based simplification for transformation functor›
 and φsimp_derived_bubbling = (60, [60,61]) for x  F (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 G T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 YY @tag 𝒜simp
    ‹Derived transformation-based simplification about bubbling›
 and derived_SE_functor = (70, [70,70]) for x  F(T)  F(W) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f(x)  F(U)  F(R) in ToA_derived
    ‹Derived rules of Separation Extraction, of a high priority as this is what
     should be attempted in reasoning. No confliction with %ToA_derived_one_to_one_functor›

φreasoner_group_assert identity_element_ToA < deriving_local_rules

paragraph ‹Separation Extraction on Semimodule›

φreasoner_group derived_SE_scalar_assoc = (30, [30,30]) for x  F (a * b) T  F (a * b) W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  F (c*d) U  F (c*d) R
                                              in ToA_derived and < derived_SE_functor
    ‹Derived rules for scalar associativity, of a low priority as  it can conflict to scalar distributive rule,
     see \cref{Semimodule-Scalar-Associative}›
 and derived_SE_scalar_distr = (35, [31, 39]) for x  F (a + b) T  F (a + b) W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  F (c+d) U  F (c+d) R
                                               in ToA_derived and > derived_SE_scalar_assoc and < derived_SE_functor
    ‹Derived rules for scalar distributivity.›
 and derived_SE_sdistr_comm_no_adz = (39, [39, 39]) in derived_SE_scalar_distr
    ‹scalar distributivity on commutative semigroup and non-zero scalar›
 and derived_SE_sdistr = (37, [37, 38]) in derived_SE_scalar_distr < derived_SE_sdistr_comm_no_adz
    ‹Derived rules for scalar distributivity on commutative semigroup›
 and derived_SE_sdistr_noassoc = (33, [33, 33]) in derived_SE_scalar_distr < derived_SE_sdistr
    ‹Derived rules for scalar distributivity on separational magma›
 and derived_SE_red_scalar_one = (30, [30,30]) for (x  F one T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  U, y  U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x  F one T)
                                                in ToA_derived and < derived_SE_sdistr_noassoc
    ‹reduce scalar one›
 and derived_SE_inj_to_module = (27, [27,28]) for (x  F one T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  U, y  U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x  F one T)
                                               in ToA_derived and < derived_SE_red_scalar_one
    ‹Derived rules lifting the target part into the module operator ‹F››
 and To_ToA_derived_SAssoc = (61, [61,61])
                             for (x  F st T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  F s (F t T) 𝗌𝗎𝖻𝗃 y. r y @tag to (𝗌𝗉𝗅𝗂𝗍-𝖺𝗌𝗌𝗈𝖼 s t))
                             in To_ToA_derived
    ‹splitting a module by associativity›
 and To_ToA_derived_SDistri = (61, [61,61])
                              for (x  F st T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  F t T  F s T 𝗌𝗎𝖻𝗃 y. r y @tag to (𝗌𝗉𝗅𝗂𝗍-𝗌𝖼𝖺𝗅𝖺𝗋 s t))
                              in To_ToA_derived
    ‹splitting a module by scalar distributivity›

(*
subsubsection ‹Guess Algebraic Operators›

φreasoner_group guess_algebraic_oprs = (100, [0, 3000]) for ‹_›
    ‹A general group consisting of reasoning rules derivign or guessing operators for algbebraic properties›
 and guess_algebraic_oprs_default = (1000, [1000, 1030]) for ‹_› in guess_algebraic_oprs
    ‹Cutting rules derivign or guessing operators for algbebraic properties›
 and guess_algebraic_oprs_cut = (1000, [1000, 1030]) for ‹_› in guess_algebraic_oprs
    ‹Cutting rules derivign or guessing operators for algbebraic properties›
*)



subsubsection ‹Configurations›

φreasoner_group Semimodule_No_SDistr   = (1000, [1000,1000]) for Semimodule_No_SDistr F ‹›
            and Transformation_Functor = (1000, [1000,1000]) in φTA_property ‹›
            and Separation_Homo        = (1000, [1000,1000]) in φTA_property ‹›
            and Module_One         = (1000, [1000,1000]) in φTA_property ‹›
            and Module_Zero            = (1000, [1000,1000]) in φTA_property ‹›
            and Module_Assoc           = (1000, [1000,1000]) in φTA_property ‹›
            and Module_Distr      = (1000, [1000,1000]) in φTA_property ‹›


declare [[
  φdefault_reasoner_group
      Tyops_Commute   F F' G G' T D R        : %φTA_commutativity_default (100)
      Tyops_Commute1_2 F F'T F'U G G' T U D r : %φTA_commutativity_default (100)
      Tyops_Commute2_1 F F'T F'U G G' T U D r : %φTA_commutativity_default (100)
      Tyops_CommuteΛI F F' G G' T D r        : %φTA_commutativity_default (100)
      Tyops_CommuteΛE F F' G G' T D r        : %φTA_commutativity_default (100)

      Transformation_Functor F1 F2 T U D R mapper             : %Transformation_Functor (100)
      Functional_Transformation_Functor Fa Fb T U D R pm fm   : %Transformation_Functor (100)
      Transformation_BiFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 m  : %Transformation_Functor (100)
      Functional_Transformation_BiFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 pm fm : %Transformation_Functor (100)
      Transformation_FunctorΛ F1 F2 T U D R m                 : %Transformation_Functor (100)
      Functional_Transformation_FunctorΛ Fa Fb T U D R pm fm  : %Transformation_Functor (100)
      CV_TrFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 mapper         : %Transformation_Functor (100)
      Fun_CV_TrFunctor Fa Fb T1 T2 U1 U2 D1 D2 FC1 R2 pm fm     : %Transformation_Functor (100)

      Separation_HomoI Ft Fu F3 T U D z                       : %Separation_Homo        (100)
      Separation_HomoI2 Ft Fu F3 T1 T2 U1 U2 D z               : %Separation_Homo        (100)
      Separation_HomoE Ft Fu F3 T U Du un                     : %Separation_Homo        (100)
      Separation_HomoE2 Ft Fu F3 T1 T2 U1 U2 Du un             : %Separation_Homo        (100)
      Separation_HomoΛI Ft Fu F3 T U D z                      : %Separation_Homo        (100)
      Separation_HomoΛE Ft Fu F3 T U Du un                    : %Separation_Homo        (100)

      Module_Zero F zero                                      : %Module_Zero            (100)
      Closed_Module_Zero F zero                               : %Module_Zero            (100)

      Module_OneI F T1 one D f P                              : %Module_One              (100)
      Module_OneE F T1 one D f P                              : %Module_One              (100)

      Module_AssocI Fs Ft Fc T Ds Dt Dx smul f                : %Module_Assoc           (100)
      Module_AssocE Fs Ft Fc T Ds Dt Dx smul f                : %Module_Assoc           (100)
      Module_AssocΛI Fs Ft Fc T Ds Dt Dx smul f               : %Module_Assoc           (100)
      Module_AssocΛE Fs Ft Fc T Ds Dt Dx smul f               : %Module_Assoc           (100)

      Module_Distr_HomoZ F Ds Dx z                            : %Module_Distr           (100)
      Module_Distr_HomoS F Ds Dx uz                           : %Module_Distr           (100)
]]


declare [[
  φpremise_attribute once? [φreason? %local] for Transformation_Functor _ _ _ _ _ _ _               (%φattr),
  φpremise_attribute once? [φreason? %local] for Functional_Transformation_Functor _ _ _ _ _ _ _ _  (%φattr),
  φpremise_attribute once? [φreason? %local] for Transformation_FunctorΛ _ _ _ _ _ _ _              (%φattr),
  φpremise_attribute once? [φreason? %local] for Functional_Transformation_FunctorΛ _ _ _ _ _ _ _ _ (%φattr),
  φpremise_attribute once? [φreason? %local] for Transformation_BiFunctor _ _ _ _ _ _ _ _ _ _ _     (%φattr),
  φpremise_attribute once? [φreason? %local] for Functional_Transformation_BiFunctor _ _ _ _ _ _ _ _ _ _ _ _ (%φattr),
  φpremise_attribute once? [φreason? %local] for CV_TrFunctor _ _ _ _ _ _ _ _ _ _ _     (%φattr),
  φpremise_attribute once? [φreason? %local] for Fun_CV_TrFunctor _ _ _ _ _ _ _ _ _ _ _ _ (%φattr),
  φpremise_attribute once? [φreason? %local] for CV_TrFunctor _ _ _ _ _ _ _ _ _ _ _     (%φattr),
  φpremise_attribute once? [φreason? %local] for Fun_CV_TrFunctor _ _ _ _ _ _ _ _ _ _ _ _ (%φattr),
  φpremise_attribute once? [φreason? %local] for Object_Sep_HomoI _ _                   (%φattr),
  φpremise_attribute once? [φreason? %local] for Object_Sep_HomoE _                     (%φattr),
  φpremise_attribute once? [φreason? %local] for Separation_HomoI _ _ _ _ _ _ _          (%φattr),
  φpremise_attribute once? [φreason? %local] for Separation_HomoI2 _ _ _ _ _ _ _ _ _          (%φattr),
  φpremise_attribute once? [φreason? %local] for Separation_HomoE _ _ _ _ _ _ _            (%φattr),
  φpremise_attribute once? [φreason? %local] for Separation_HomoE2 _ _ _ _ _ _ _ _ _          (%φattr),
  φpremise_attribute once? [φreason? %local] for Separation_HomoI_Cond _ _ _ _ _ _ _ _   (%φattr),
  φpremise_attribute once? [φreason? %local] for Separation_HomoI2_Cond _ _ _ _ _ _ _ _ _ _   (%φattr),
  φpremise_attribute once? [φreason? %local] for Separation_HomoE_Cond _ _ _ _ _ _ _ _   (%φattr),
  φpremise_attribute once? [φreason? %local] for Separation_HomoE2_Cond _ _ _ _ _ _ _ _ _ _   (%φattr),
  φpremise_attribute once? [φreason? %local] for Module_Zero _ _                    (%φattr),
  φpremise_attribute once? [φreason? %local] for Closed_Module_Zero _ _             (%φattr),
  φpremise_attribute once? [φreason? %local] for Module_OneI _ _ _ _ _ _            (%φattr),
  φpremise_attribute once? [φreason? %local] for Module_OneE _ _ _ _ _ _            (%φattr),
  φpremise_attribute once? [φreason? %local] for Module_AssocI _ _ _ _ _ _ _ _ _ (%φattr),
  φpremise_attribute once? [φreason? %local] for Module_AssocE _ _ _ _ _ _ _ _ _ (%φattr),
  φpremise_attribute once? [φreason? %local] for Module_Distr_HomoZ _ _ _ _             (%φattr),
  φpremise_attribute once? [φreason? %local] for Module_Distr_HomoZ_rev _ _ _ _ _ _     (%φattr),
  φpremise_attribute once? [φreason? %local] for Module_Distr_HomoS _ _ _ _             (%φattr),
  φpremise_attribute once? [φreason? %local] for Module_Distr_HomoS_rev _ _ _ _ _ _     (%φattr),
  φpremise_attribute once? [φreason? %local] for Tyops_Commute _ _ _ _ _ _ _                 (%φattr),
  φpremise_attribute once? [φreason? %local] for Tyops_CommuteΛI _ _ _ _ _ _ _      (%φattr),
  φpremise_attribute once? [φreason? %local] for Tyops_CommuteΛE _ _ _ _ _ _ _      (%φattr),
  φpremise_attribute once? [φreason? %local] for Tyops_Commute1_2 _ _ _ _ _ _ _ _ _  (%φattr),
  φpremise_attribute once? [φreason? %local] for Tyops_Commute2_1 _ _ _ _ _ _ _ _ _  (%φattr),

  φreason_default_pattern
      Transformation_Functor ?Fa ?Fb _ _ _ _ _ 
      Transformation_Functor ?Fa _ _ _ _ _ _
      Transformation_Functor _ ?Fb _ _ _ _ _   (100)
  and Functional_Transformation_Functor ?Fa ?Fb _ _ _ _ _ _ 
      Functional_Transformation_Functor ?Fa _ _ _ _ _ _ _
      Functional_Transformation_Functor _ ?Fb _ _ _ _ _ _   (100)
  and Transformation_FunctorΛ ?Fa ?Fb _ _ _ _ _ 
      Transformation_FunctorΛ ?Fa _ _ _ _ _ _
      Transformation_FunctorΛ _ ?Fb _ _ _ _ _   (100)
  and Functional_Transformation_FunctorΛ ?Fa ?Fb _ _ _ _ _ _ 
      Functional_Transformation_FunctorΛ ?Fa _ _ _ _ _ _ _
      Functional_Transformation_FunctorΛ _ ?Fb _ _ _ _ _ _   (100)
  and Transformation_BiFunctor ?Fa ?Fb _ _ _ _ _ _ _ _ _ 
      Transformation_BiFunctor ?Fa _ _ _ _ _ _ _ _ _ _
      Transformation_BiFunctor _ ?Fb _ _ _ _ _ _ _ _ _   (100)
  and Functional_Transformation_BiFunctor ?Fa ?Fb _ _ _ _ _ _ _ _ _ _ 
      Functional_Transformation_BiFunctor ?Fa _ _ _ _ _ _ _ _ _ _ _
      Functional_Transformation_BiFunctor _ ?Fb _ _ _ _ _ _ _ _ _ _   (100)
  and CV_TrFunctor ?Fa ?Fb _ _ _ _ _ _ _ _ _ 
      CV_TrFunctor ?Fa _ _ _ _ _ _ _ _ _ _
      CV_TrFunctor _ ?Fb _ _ _ _ _ _ _ _ _   (100)
  and Fun_CV_TrFunctor ?Fa ?Fb _ _ _ _ _ _ _ _ _ _ 
      Fun_CV_TrFunctor ?Fa _ _ _ _ _ _ _ _ _ _ _
      Fun_CV_TrFunctor _ ?Fb _ _ _ _ _ _ _ _ _ _   (100)
  and Separation_HomoI ?Ft ?Fu ?Fc _ _ _ _ 
      Separation_HomoI ?Ft _ _ _ _ _ _
      Separation_HomoI _ ?Fu _ _ _ _ _
      Separation_HomoI _ _ ?Fc _ _ _ _    (100)
  and Separation_HomoI2 ?Ft ?Fu ?Fc _ _ _ _ _ _ 
      Separation_HomoI2 ?Ft _ _ _ _ _ _ _ _
      Separation_HomoI2 _ ?Fu _ _ _ _ _ _ _
      Separation_HomoI2 _ _ ?Fc _ _ _ _ _ _    (100)
  and Separation_HomoE ?Ft ?Fu ?Fc _ _ _ _ 
      Separation_HomoE _ _ ?Fc _ _ _ _
      Separation_HomoE _ ?Fu _ _ _ _ _
      Separation_HomoE ?Ft _ _ _ _ _ _    (100)
  and Separation_HomoE2 ?Ft ?Fu ?Fc _ _ _ _ _ _ 
      Separation_HomoE2 ?Ft _ _ _ _ _ _ _ _
      Separation_HomoE2 _ ?Fu _ _ _ _ _ _ _
      Separation_HomoE2 _ _ ?Fc _ _ _ _ _ _    (100)
  and Separation_HomoΛI ?Ft ?Fu ?Fc _ _ _ _ 
      Separation_HomoΛI ?Ft _ _ _ _ _ _
      Separation_HomoΛI _ ?Fu _ _ _ _ _
      Separation_HomoΛI _ _ ?Fc _ _ _ _  (100)
  and Separation_HomoΛE ?Ft ?Fu ?Fc _ _ _ _ 
      Separation_HomoΛE ?Ft _ _ _ _ _ _
      Separation_HomoΛE _ ?Fu _ _ _ _ _
      Separation_HomoΛE _ _ ?Fc _ _ _ _    (100)
  and Object_Sep_HomoI ?T _  Object_Sep_HomoI ?T _ (100)
  and Separation_HomoI_Cond ?Ft ?Fu ?Fc _ _ _ _ _ 
      Separation_HomoI_Cond ?Ft _ _ _ _ _ _ _
      Separation_HomoI_Cond _ ?Fu _ _ _ _ _ _
      Separation_HomoI_Cond _ _ ?Fc _ _ _ _ _  (100)
  and Separation_HomoI2_Cond ?Ft ?Fu ?Fc _ _ _ _ _ _ _ 
      Separation_HomoI2_Cond ?Ft _ _ _ _ _ _ _ _ _
      Separation_HomoI2_Cond _ ?Fu _ _ _ _ _ _ _ _
      Separation_HomoI2_Cond _ _ ?Fc _ _ _ _ _ _ _  (100)
  and Separation_HomoE_Cond ?Ft ?Fu ?Fc _ _ _ _ _ 
      Separation_HomoE_Cond ?Ft _ _ _ _ _ _ _
      Separation_HomoE_Cond _ ?Fu _ _ _ _ _ _
      Separation_HomoE_Cond _ _ ?Fc _ _ _ _ _  (100)
  and Separation_HomoE2_Cond ?Ft ?Fu ?Fc _ _ _ _ _ _ _ 
      Separation_HomoE2_Cond ?Ft _ _ _ _ _ _ _ _ _
      Separation_HomoE2_Cond _ ?Fu _ _ _ _ _ _ _ _
      Separation_HomoE2_Cond _ _ ?Fc _ _ _ _ _ _ _  (100)
  and Separation_HomoΛI_Cond ?Ft ?Fu ?Fc _ _ _ _ _ 
      Separation_HomoΛI_Cond ?Ft _ _ _ _ _ _ _
      Separation_HomoΛI_Cond _ ?Fu _ _ _ _ _ _
      Separation_HomoΛI_Cond _ _ ?Fc _ _ _ _ _  (100)
  and Separation_HomoΛE_Cond ?Ft ?Fu ?Fc _ _ _ _ _ 
      Separation_HomoΛE_Cond ?Ft _ _ _ _ _ _ _
      Separation_HomoΛE_Cond _ ?Fu _ _ _ _ _ _
      Separation_HomoΛE_Cond _ _ ?Fc _ _ _ _ _  (100)
  and Module_Distr_HomoZ ?F _ _ _  Module_Distr_HomoZ ?F _ _ _ (100)
  and Module_Distr_HomoS ?F _ _ _  Module_Distr_HomoS ?F _ _ _ (100)
  and Module_Distr_HomoZ_rev ?F _ _ _ _ _  Module_Distr_HomoZ_rev ?F _ _ _ _ _ (100)
  and Module_Distr_HomoS_rev ?F _ _ _ _ _  Module_Distr_HomoS_rev ?F _ _ _ _ _ (100)
  and Semimodule_No_SDistr ?F  Semimodule_No_SDistr ?F (100)
  and Tyops_Commute ?F _ ?G _ ?T _ _  Tyops_Commute ?F _ ?G _ ?T _ _ (100)
  and Tyops_CommuteΛI ?F _ ?G _ ?T _ _  Tyops_CommuteΛI ?F _ ?G _ ?T _ _ (100)
  and Tyops_CommuteΛE ?F _ ?G _ ?T _ _  Tyops_CommuteΛE ?F _ ?G _ ?T _ _ (100)
  and Tyops_Commute1_2 ?F _ _ ?G _ ?T ?U _ _ 
      Tyops_Commute1_2 ?F _ _ ?G _ ?T ?U _ _   (100)
  and Tyops_Commute2_1 ?F _ _ ?G _ ?T ?U _ _ 
      Tyops_Commute2_1 ?F _ _ ?G _ ?T ?U _ _   (100)
]]


paragraph ‹Configuring Property Data Base›

(* hide_fact φinductive_destruction_rule_from_direct_definition
          φinductive_destruction_rule_from_direct_definition'
          φType_conv_eq_1 φType_conv_eq_2 φintro_transformation *)

setup let fun attach_var F =
      let val i = maxidx_of_term F + 1
       in case fastype_of F of Typefun T _ => F $ Var(("uu",i),T)
                             | _ => error "Impossible #8da16473-84ef-4bd8-9a96-331bcff88011"
      end
    open PLPR_Template_Properties
in (*Phi_Type.Detection_Rewr.setup_attribute binding‹φfunctor_of›
  "set the pattern rewrite to parse the functor part and the argument part from a term\
  \ matching the patter"
#>*)add_property_kinds [
  pattern_propTransformation_Functor _ _ _ _ _ _ _,
  pattern_propFunctional_Transformation_Functor _ _ _ _ _ _ _ _,
  pattern_propTransformation_FunctorΛ _ _ _ _ _ _ _,
  pattern_propFunctional_Transformation_FunctorΛ _ _ _ _ _ _ _ _,
  pattern_propTransformation_BiFunctor _ _ _ _ _ _ _ _ _ _ _,
  pattern_propFunctional_Transformation_BiFunctor _ _ _ _ _ _ _ _ _ _ _ _,
  pattern_propCV_TrFunctor _ _ _ _ _ _ _ _ _ _ _,
  pattern_propFun_CV_TrFunctor _ _ _ _ _ _ _ _ _ _ _ _,
  pattern_propSeparation_HomoI _ _ _ _ _ _ _,
  pattern_propSeparation_HomoI2 _ _ _ _ _ _ _ _ _,
  pattern_propSeparation_HomoE _ _ _ _ _ _ _,
  pattern_propSeparation_HomoE2 _ _ _ _ _ _ _ _ _,
  pattern_propSeparation_HomoI_Cond _ _ _ _ _ _ _ _,
  pattern_propSeparation_HomoI2_Cond _ _ _ _ _ _ _ _ _ _,
  pattern_propSeparation_HomoE_Cond _ _ _ _ _ _ _ _,
  pattern_propSeparation_HomoE2_Cond _ _ _ _ _ _ _ _ _ _,
  pattern_propSeparation_HomoΛI _ _ _ _ _ _ _,
  pattern_propSeparation_HomoΛE _ _ _ _ _ _ _,
  pattern_propSeparation_HomoΛI_Cond _ _ _ _ _ _ _ _,
  pattern_propSeparation_HomoΛE_Cond _ _ _ _ _ _ _ _,
  pattern_propClosed_Module_Zero _ _,
  pattern_propModule_Zero _ _,
  pattern_propModule_OneI _ _ _ _ _ _,
  pattern_propModule_OneE _ _ _ _ _ _,
  pattern_propModule_AssocI _ _ _ _ _ _ _ _ _,
  pattern_propModule_AssocE _ _ _ _ _ _ _ _ _,
  pattern_propModule_Distr_HomoZ _ _ _ _,
  pattern_propModule_Distr_HomoS _ _ _ _,
  pattern_propSemimodule_No_SDistr _,
  pattern_propTyops_Commute _ _ _ _ _ _ _,
  pattern_propTyops_CommuteΛI _ _ _ _ _ _ _,
  pattern_propTyops_CommuteΛE _ _ _ _ _ _ _,
  pattern_propTyops_Commute1_2 _ _ _ _ _ _ _ _ _,
  pattern_propTyops_Commute2_1 _ _ _ _ _ _ _ _ _
]

(*#> Phi_Type.add_property_kind const_name‹Object_Equiv› (fn (_ $ T $ _) => T)*)
― ‹We do not add Object_Equiv into the property-based template instantiation here because
  it can have special overridings for singular points like that many type operators F› have a
  wider reachability relation at F ○›. The overloadings multiply the resulted instantiations
  and they requires priority precedence which is not in the capability of the template
  instantiation automation.›
end
  
setup PLPR_Template_Properties.add_property_kinds [
  pattern_propTERM (Identity_ElementsI _),
  pattern_propTERM (Identity_ElementsE _)
]

declare [[
  φreason_default_pattern TERM (Identity_ElementsI ?F)  TERM (Identity_ElementsI ?FF) (100)
                      and TERM (Identity_ElementsE ?F)  TERM (Identity_ElementsE ?FF) (100)
]]

text ‹Candidates of templates instantiation are not prioritized. When a property requires multiple
  rules ordered by their priorities for overrides and optimizations, the property is not declared
  as a parameter property in the template instantiation system but just a φ-LPR reasoning goal tagged
  by 𝒜_template_reason› in the template.
  Instead, a trigger TERM (The_Property F)› is used as the parameter property activating
  the instantiation and (when the trigger is given) indicating when the prioritized rules are all given
  so when can the instantiation start. ›



subsection ‹Direct Applications \& Properties›

text ‹Directly applying the algebraic properties.›

subsubsection ‹Transformation Functor›

lemma Transformation_Functor_sub_dom:
  (x. Da x  Db x)
 Transformation_Functor F1 F2 T U Da R mapper
 Transformation_Functor F1 F2 T U Db R mapper
  unfolding Transformation_Functor_def
  by (clarsimp simp add: subset_iff; blast)

lemma Transformation_Functor_sub_rng:
  (x. Rb x  Ra x)
 Transformation_Functor F1 F2 T U D Ra mapper
 Transformation_Functor F1 F2 T U D Rb mapper
  unfolding Transformation_Functor_def
  by (clarsimp simp add: subset_iff; blast)

lemma Transformation_Functor_sub_mapper:
  ma  mb
 Transformation_Functor F1 F2 T U D R ma
 Transformation_Functor F1 F2 T U D R mb
  unfolding Transformation_Functor_def
  by (clarsimp simp add: le_fun_def Transformation_def Ball_def, blast)

lemma apply_Transformation_Functor:
  Transformation_Functor Fa Fb T U D R mapper
 (a. 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 a  D x  a  T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U 𝗌𝗎𝖻𝗃 b. g a b)
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (a b. a  D x  g a b  b  R x)
 x  Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  Fb U 𝗌𝗎𝖻𝗃 y. mapper g x y
  unfolding Transformation_Functor_def Premise_def
  by simp

lemma apply_Functional_Transformation_Functor:
  Functional_Transformation_Functor Fa Fb T U D R pred_mapper func_mapper
 (a  D x. 𝗎𝗌𝖾𝗋 a  T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f a  U 𝗐𝗂𝗍𝗁 P a)
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (a. a  D x  f a  R x) 
 x  Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 func_mapper f P x  Fb U 𝗐𝗂𝗍𝗁 pred_mapper f P x
  unfolding meta_Ball_def Argument_def Premise_def
            Functional_Transformation_Functor_def Transformation_Functor_def
  by clarsimp


subsubsection ‹Transformation Bi-Functor›

lemma Transformation_BiFunctor_sub_dom:
  (x. D1 x  D1' x)
 (x. D2 x  D2' x)
 Transformation_BiFunctor F1 F2 T1 T2 U1 U2 D1 D2 R1 R2 mapper
 Transformation_BiFunctor F1 F2 T1 T2 U1 U2 D1' D2' R1 R2 mapper
  unfolding Transformation_BiFunctor_def
  by (clarsimp simp add: subset_iff; blast)

lemma CV_TrFunctor_sub_dom:
  (x. D1 x  D1' x)
 (x. D2 x  D2' x)
 CV_TrFunctor F1 F2 T1 T2 U1 U2 D1 D2 R1 R2 mapper
 CV_TrFunctor F1 F2 T1 T2 U1 U2 D1' D2' R1 R2 mapper
  unfolding CV_TrFunctor_def
  by (clarsimp simp add: subset_iff; smt)

lemma Transformation_BiFunctor_sub_rng:
  (x. R1' x  R1 x)
 (x. R2' x  R2 x)
 Transformation_BiFunctor F1 F2 T1 T2 U1 U2 D1 D2 R1  R2  mapper
 Transformation_BiFunctor F1 F2 T1 T2 U1 U2 D1 D2 R1' R2' mapper
  unfolding Transformation_BiFunctor_def
  by (clarsimp simp add: subset_iff; blast)

lemma Transformation_BiFunctor_sub_mapper:
  ma  mb
 Transformation_BiFunctor F1 F2 T1 T2 U1 U2 D1 D2 R1 R2 ma
 Transformation_BiFunctor F1 F2 T1 T2 U1 U2 D1 D2 R1 R2 mb
  unfolding Transformation_BiFunctor_def le_fun_def Transformation_def
  by (clarsimp simp add: Ball_def; smt (verit, best))

lemma apply_Transformation_BiFunctor:
  Transformation_BiFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 mapper
 (a. 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 a  D1 x  a  T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U1 𝗌𝗎𝖻𝗃 b. g1 a b)
 (a. 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 a  D2 x  a  T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U2 𝗌𝗎𝖻𝗃 b. g2 a b)
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (a b. a  D1 x  g1 a b  b  R1 x)  (a b. a  D2 x  g2 a b  b  R2 x)
 x  Fa T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  Fb U1 U2 𝗌𝗎𝖻𝗃 y. mapper g1 g2 x y
  unfolding Transformation_BiFunctor_def Premise_def
  by simp

(*
lemma apply_CV_TrFunctor:
  ‹ CV_TrFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 mapper
⟹ (⋀a. 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∃b. g1 a b ∧ b ∈ D1 x) ⟹ a ⦂ U1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ T1 𝗌𝗎𝖻𝗃 b. g1 a b)
⟹ (⋀a. 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 a ∈ D2 x ⟹ a ⦂ T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U2 𝗌𝗎𝖻𝗃 b. g2 a b)
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀a b. b ∈ D1 x ∧ g1 a b ⟶ a ∈ R1 x) ∧ (∀a b. a ∈ D2 x ∧ g2 a b ⟶ b ∈ R2 x)
⟹ x ⦂ Fa T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Fb U1 U2 𝗌𝗎𝖻𝗃 y. mapper g1 g2 x y ›
  unfolding CV_TrFunctor_def Premise_def
  by simp
*)

lemma apply_Functional_Transformation_BiFunctor:
  Functional_Transformation_BiFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 pred_mapper func_mapper
 (a  D1 x. 𝗎𝗌𝖾𝗋 a  T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f1 a  U1 𝗐𝗂𝗍𝗁 P1 a)
 (a  D2 x. 𝗎𝗌𝖾𝗋 a  T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f2 a  U2 𝗐𝗂𝗍𝗁 P2 a)
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (a. a  D1 x  f1 a  R1 x)  (a. a  D2 x  f2 a  R2 x)
 x  Fa T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 func_mapper f1 f2 P1 P2 x  Fb U1 U2 𝗐𝗂𝗍𝗁 pred_mapper f1 f2 P1 P2 x
  unfolding meta_Ball_def Argument_def Premise_def
            Functional_Transformation_BiFunctor_def Transformation_Functor_def
  by clarsimp

lemma apply_Functional_CV_BiFunctor:
  Fun_CV_TrFunctor Fa Fb T1 T2 U1 U2 D1 D2 FC1 R2 pred_mapper func_mapper
 (a. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 f1 a  D1 x  𝗎𝗌𝖾𝗋 a  U1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f1 a  T1 𝗐𝗂𝗍𝗁 P1 a)
 (a  D2 x. 𝗎𝗌𝖾𝗋 a  T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f2 a  U2 𝗐𝗂𝗍𝗁 P2 a)
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 FC1 f1 x  (a. a  D2 x  f2 a  R2 x)
 x  Fa T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 func_mapper f1 f2 P1 P2 x  Fb U1 U2 𝗐𝗂𝗍𝗁 pred_mapper f1 f2 P1 P2 x
  unfolding meta_Ball_def Argument_def Premise_def
            Fun_CV_TrFunctor_def Transformation_Functor_def
  by clarsimp


subsubsection ‹Transformation Functor with Parameterization›

lemma Transformation_FunctorΛ_sub_dom:
  (p x. Da p x  Db p x)
 Transformation_FunctorΛ F1 F2 T U Da R mapper
 Transformation_FunctorΛ F1 F2 T U Db R mapper
  unfolding Transformation_FunctorΛ_def
  by (clarsimp simp add: subset_iff; blast)

lemma Transformation_FunctorΛ_sub_rng:
  (p x. Rb p x  Ra p x)
 Transformation_FunctorΛ F1 F2 T U D Ra mapper
 Transformation_FunctorΛ F1 F2 T U D Rb mapper
  unfolding Transformation_FunctorΛ_def
  by (clarsimp simp add: subset_iff; blast)

lemma Transformation_FunctorΛ_sub_mapper:
  ma  mb
 Transformation_FunctorΛ F1 F2 T U D R ma
 Transformation_FunctorΛ F1 F2 T U D R mb
  unfolding Transformation_FunctorΛ_def
  by (clarsimp simp add: le_fun_def Transformation_def Ball_def, blast)

lemma apply_Transformation_FunctorΛ:
  Transformation_FunctorΛ Fa Fb T U D R mapper
 (p a. 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 a  D p x  a  T p 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U p 𝗌𝗎𝖻𝗃 b. g p a b)
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (p a b. a  D p x  g p a b  b  R p x)
 x  Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  Fb U 𝗌𝗎𝖻𝗃 y. mapper g x y
  unfolding Transformation_FunctorΛ_def Premise_def Transformation_def
  by clarsimp

lemma apply_Functional_Transformation_FunctorΛ:
  Functional_Transformation_FunctorΛ Fa Fb T U D R pred_mapper func_mapper
 (p. a  D p x. 𝗎𝗌𝖾𝗋 a  T p 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f p a  U p 𝗐𝗂𝗍𝗁 P p a)
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (p a. a  D p x  f p a  R p x) 
 x  Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 func_mapper f P x  Fb U 𝗐𝗂𝗍𝗁 pred_mapper f P x
  unfolding meta_Ball_def Argument_def Premise_def Functional_Transformation_FunctorΛ_def
  by clarsimp


subsubsection ‹Separation Homo / Functor›

lemma apply_sep_homo:
  Object_Sep_HomoI T D
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (x,y)  D
 (x  T) * (y  T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x * y  T 𝗐𝗂𝗍𝗁 x ## y
  unfolding Object_Sep_HomoI_def Premise_def by simp

lemma apply_sep_homo_unzip:
  Object_Sep_HomoE T
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x ## y
 (x * y  T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (x  T) * (y  T)
  unfolding Object_Sep_HomoE_def Premise_def by blast

lemma Separation_HomoI_sub_D:
  D'  D
 Separation_HomoI Fa Fb Fc T U D  z
 Separation_HomoI Fa Fb Fc T U D' z
  unfolding Separation_HomoI_def
  by blast

lemma Separation_HomoI2_sub_D:
  D'  D
 Separation_HomoI2 Fa Fb Fc T1 T2 U1 U2 D  z
 Separation_HomoI2 Fa Fb Fc T1 T2 U1 U2 D' z
  unfolding Separation_HomoI2_def
  by blast


lemma Separation_HomoI_Cond_sub_D:
  D'  D
 Separation_HomoI_Cond Fa Fb Fc CW T U D  z
 Separation_HomoI_Cond Fa Fb Fc CW T U D' z
  unfolding Separation_HomoI_Cond_def
  by blast


lemma Separation_HomoI_Cond2_sub_D:
  D'  D
 Separation_HomoI2_Cond Fa Fb Fc CW T1 T2 U1 U2 D  z
 Separation_HomoI2_Cond Fa Fb Fc CW T1 T2 U1 U2 D' z
  unfolding Separation_HomoI2_Cond_def
  by blast


lemma Separation_HomoE_Cond_sub_D:
  D'  D
 Separation_HomoE_Cond Fa Fb Fc CR T U D  z
 Separation_HomoE_Cond Fa Fb Fc CR T U D' z
  unfolding Separation_HomoE_Cond_def
  by blast

lemma apply_Separation_HomoI:
  Separation_HomoI Ft Fu Fc T U D z
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x  D
 x  Ft(T)  Fu(U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z x  Fc(T  U)
  unfolding Separation_HomoI_def Premise_def meta_Ball_def meta_case_prod_def split_paired_all
  by (cases x; simp)

lemma apply_Separation_HomoI2 :
  Separation_HomoI2 Ft Fu Fc T1 T2 U1 U2 D z
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x  D
 x  Ft T1 T2  Fu U1 U2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z x  Fc (T1  U1) (T2  U2)
  unfolding Separation_HomoI2_def Premise_def meta_Ball_def meta_case_prod_def split_paired_all
  by (cases x; simp)

lemma apply_Separation_HomoE:
  Separation_HomoE Ft Fu Fc T U Du un
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x  Du
 x  Fc(T  U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 un x  Ft(T)  Fu(U)
  unfolding Separation_HomoE_def φProd_expn'[symmetric] Premise_def
  by simp

lemma apply_Separation_HomoE2:
  Separation_HomoE2 Ft Fu Fc T1 T2 U1 U2 Du un
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x  Du
 x  Fc (T1  U1) (T2  U2) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 un x  Ft T1 T2  Fu U1 U2
  unfolding Separation_HomoE2_def φProd_expn'[symmetric] Premise_def
  by simp

lemma apply_Separation_HomoI_Cond:
  Separation_HomoI_Cond Ft Fu Fc C T U D z
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x  D
 x  Ft T  ◒[C] Fu U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z x  Fc (T  ◒[C] U)
  unfolding Separation_HomoI_Cond_def Premise_def split_paired_all
  by (cases x; simp)


lemma apply_Separation_HomoI2_Cond:
  Separation_HomoI2_Cond Ft Fu Fc CR T1 T2 U1 U2 D z
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x  D
 x  Ft T1 T2  ◒[CR] Fu U1 U2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z x  Fc (T1  ◒[CR] U1) (T2  ◒[CR] U2)
  unfolding Separation_HomoI2_Cond_def Premise_def split_paired_all
  by (cases x; simp)

(*
lemma apply_Separation_HomoI_Cond3':
  ‹ Separation_HomoI_Cond FT FU FTU CU T U D1 z1
⟹ Separation_HomoI_Cond FTU FW F3 CW (T ∗[CU] U) W D2 z2
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 fst x ∈ D1 ∧ apfst z1 x ∈ D2
⟹ x ⦂ (FT T ∗[CU] FU U) ∗[CW] FW W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z2 (apfst z1 x) ⦂ F3 ((T ∗[CU] U) ∗[CW] W) ›
  unfolding Separation_HomoI_Cond_def Premise_def split_paired_all Transformation_def
  by (cases CU; cases CW; cases x; simp; metis prod.collapse)
*)

lemma apply_Separation_HomoE_Cond:
  Separation_HomoE_Cond Ft Fu Fc C T U D un
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x  D
 x  Fc (T  ◒[C] U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 un x  Ft T  ◒[C] Fu U
  unfolding Separation_HomoE_Cond_def φProd_expn'[symmetric] Premise_def
  by simp

lemma apply_Separation_HomoE2_Cond:
  Separation_HomoE2_Cond Ft Fu Fc C T1 T2 U1 U2 D un
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x  D
 x  Fc (T1  ◒[C] U1) (T2  ◒[C] U2) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 un x  Ft T1 T2  ◒[C] Fu U1 U2
  unfolding Separation_HomoE2_Cond_def φProd_expn'[symmetric] Premise_def
  by simp

paragraph ‹With Parameterization›

lemma Separation_HomoΛI_sub_D:
  D'  D
 Separation_HomoΛI Fa Fb Fc T U D  z
 Separation_HomoΛI Fa Fb Fc T U D' z
  unfolding Separation_HomoΛI_def
  by blast

lemma Separation_HomoΛI_Cond_sub_D:
  D'  D
 Separation_HomoΛI_Cond Fa Fb Fc CW T U D  z
 Separation_HomoΛI_Cond Fa Fb Fc CW T U D' z
  unfolding Separation_HomoΛI_Cond_def
  by blast

lemma Separation_HomoΛE_Cond_sub_D:
  D'  D
 Separation_HomoΛE_Cond Fa Fb Fc CR T U D  z
 Separation_HomoΛE_Cond Fa Fb Fc CR T U D' z
  unfolding Separation_HomoΛE_Cond_def
  by blast

lemma apply_Separation_HomoΛI:
  Separation_HomoΛI Ft Fu Fc T U D z
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x  D
 x  Ft(T)  Fu(U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z x  Fc(λp. T p  U p)
  unfolding Separation_HomoΛI_def Premise_def meta_Ball_def meta_case_prod_def split_paired_all
  by (cases x; simp)

lemma apply_Separation_HomoΛE:
  Separation_HomoΛE Ft Fu Fc T U Du un
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x  Du
 x  Fc(λp. T p  U p) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 un x  Ft(T)  Fu(U)
  unfolding Separation_HomoΛE_def φProd_expn'[symmetric] Premise_def
  by simp

lemma apply_Separation_HomoΛI_Cond:
  Separation_HomoΛI_Cond Ft Fu Fc CR T U D z
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x  D
 x  Ft(T)  ◒[CR] Fu(U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z x  Fc(λp. T p  ◒[CR] U p)
  unfolding Separation_HomoΛI_Cond_def Premise_def split_paired_all
  by (cases x; simp)

lemma apply_Separation_HomoΛE_Cond:
  Separation_HomoΛE_Cond Ft Fu Fc CW T U D un
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x  D
 x  Fc(λp. T p  ◒[CW] U p) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 un x  Ft(T)  ◒[CW] Fu(U)
  unfolding Separation_HomoΛE_Cond_def φProd_expn'[symmetric] Premise_def
  by simp


subsubsection ‹Semimodule›

paragraph ‹Association›

lemma apply_Semimodule_SAssocI:
  Module_AssocI Fs Ft Fc T Ds Dt Dx smul f
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds s  Dt t  Dx s t x
 x  Fs s (Ft t T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f s t x  Fc (smul s t) T
  unfolding Module_AssocI_def Premise_def
  by clarsimp

lemma apply_Semimodule_SAssocE:
  Module_AssocE Fs Ft Fc T Ds Dt Dx smul f
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds s  Dt t  Dx s t x
 x  Fc (smul s t) T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f s t x  Fs s (Ft t T)
  unfolding Module_AssocE_def Premise_def
  by clarsimp


paragraph ‹Identity Element›

lemma apply_Module_OneI:
  Module_OneI F T1 one D f P
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
 x  T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x  F one 𝗐𝗂𝗍𝗁 P x
  unfolding Module_OneI_def Premise_def
  by simp

(*
lemma apply_Module_OneI_φSome:
  ‹ Module_OneI F T1 one D f P
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ x ⦂ ● T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x ⦂ ● F one 𝗐𝗂𝗍𝗁 P x ›
  unfolding Module_OneI_def Premise_def φSome_transformation_strip
  by simp
*)

lemma apply_Module_OneE:
  Module_OneE F T1 one D f P
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
 x  F one 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x  T1 𝗐𝗂𝗍𝗁 P x
  unfolding Module_OneE_def Premise_def
  by simp

(*
lemma apply_Module_OneE_φSome:
  ‹ Module_OneE F T1 one D f P
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
⟹ x ⦂ ● F one 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x ⦂ ● T1 𝗐𝗂𝗍𝗁 P x ›
  unfolding Module_OneE_def Premise_def φSome_transformation_strip
  by simp
*)


paragraph ‹Left Distributivity›

lemma Module_Distr_HomoZ_sub:
  Ds  Ds'  Dx  Dx'
 Module_Distr_HomoZ F Ds' Dx' z
 Module_Distr_HomoZ F Ds Dx z
  unfolding Module_Distr_HomoZ_def le_fun_def le_bool_def
  by blast

lemma [φadding_property = false,
       φreason %φTA_varify_out except Module_Distr_HomoZ _ ?var_Ds ?var_Dx _,
       φadding_property = true ]:
  Module_Distr_HomoZ F Ds' Dx' z
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds  Ds'  Dx  Dx'
 Module_Distr_HomoZ F Ds Dx z
  unfolding Premise_def
  using Module_Distr_HomoZ_sub by blast

lemma apply_Module_Distr_HomoZ:
  Module_Distr_HomoZ F Ds Dx z
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds s  Ds t  s ##+ t  Dx s t x
 x  F s  F t 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z s t x  F (s + t)
  unfolding Module_Distr_HomoZ_def Premise_def
  by blast

(*
lemma apply_Module_Distr_HomoZ_φSome:
  ‹ Module_Distr_HomoZ F Ds Dx z
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds s ∧ Ds t ∧ s ##+ t ∧ Dx s t x
⟹ x ⦂ ● F s ∗ ● F t 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z s t x ⦂ ● F (s + t) ›
  unfolding Module_Distr_HomoZ_def Premise_def Transformation_def
  by (clarsimp; metis prod.collapse)
*)

lemma apply_Module_Distr_HomoZ_RCond_φSome:
  Module_Distr_HomoZ F Ds Dx z
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (C  Ds s  Ds t  s ##+ t  Dx s t x)  ?+ True r = ?+ True s + ?+ C t
 x  F s  ◒[C] F t 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?jR C (z s t) x  F r
  unfolding Module_Distr_HomoZ_def Premise_def Transformation_def
  by (cases C; clarsimp; metis prod.collapse)

lemma apply_Module_Distr_HomoZ_LCond_φSome:
  Module_Distr_HomoZ F Ds Dx z
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (C  Ds s  Ds t  s ##+ t  Dx s t x)  ?+ True r = ?+ C s + ?+ True t
 x  ◒[C] F s  F t 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?jL C (z s t) x  F r
  unfolding Module_Distr_HomoZ_def Premise_def Transformation_def
  by (cases C; clarsimp; metis prod.collapse)


lemma apply_Module_Distr_HomoZ_rev:
  Module_Distr_HomoZ F Ds Dx' z'
 Module_Distr_HomoZ_rev F Ds Dx' z' Dx z
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds s  Ds t  t ##+ s  Dx s t x
 x  F s  F t 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z s t x  F (t + s)
  unfolding Module_Distr_HomoZ_rev_def Premise_def
  by blast

(*
lemma apply_Module_Distr_HomoZ_rev_LCond_φSome:
  ‹ Module_Distr_HomoZ F Ds Dx' z'
⟹ Module_Distr_HomoZ_rev F Ds Dx' z' Dx z
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (C ⟶ Ds s ∧ Ds t ∧ t ##+ s ∧ Dx s t x) ∧ ?+ True r = ?+ C t + ?+ True s
⟹ x ⦂ ● F s ∗ ◒[C] F t 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?jR C (z s t) x ⦂ ● F r ›
  unfolding Module_Distr_HomoZ_def Premise_def Transformation_def
            Module_Distr_HomoZ_rev_def
  by (cases C; clarsimp; metis prod.collapse)

lemma apply_Module_Distr_HomoZ_rev_φSome:
  ‹ Module_Distr_HomoZ F Ds Dx' z'
⟹ Module_Distr_HomoZ_rev F Ds Dx' z' Dx z
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds s ∧ Ds t ∧ t ##+ s ∧ Dx s t x
⟹ x ⦂ ● F s ∗ ● F t 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z s t x ⦂ ● F (t + s) ›
  unfolding Module_Distr_HomoZ_rev_def Premise_def Transformation_def
  by (clarsimp; metis prod.collapse)
*)

lemma apply_Module_Distr_HomoS:
  Module_Distr_HomoS F Ds Dx uz
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds s  Ds t  s ##+ t  Dx s t x
 x  F (s + t) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 uz s t x  F s  F t
  unfolding Module_Distr_HomoS_def Premise_def
  by blast

(*
lemma apply_Module_Distr_HomoS_φSome:
  ‹ Module_Distr_HomoS F Ds Dx uz
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds s ∧ Ds t ∧ s ##+ t ∧ Dx s t x
⟹ x ⦂ ● F (s + t) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 uz s t x ⦂ ● F s ∗ ● F t ›
  unfolding Module_Distr_HomoS_def Premise_def Transformation_def
  by (clarsimp; metis sep_disj_option(1) times_option(1))
*)

lemma apply_Module_Distr_HomoS_RCond:
  Module_Distr_HomoS F Ds Dx uz
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (C  Ds s  Ds t  s ##+ t  Dx s t x) 
           ?+ True r = ?+ True s + ?+ C t
 x  F r 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?sR C (uz s t) x  F s  ◒[C] F t
  unfolding Premise_def Module_Distr_HomoS_def Transformation_def
  by (cases C; clarsimp; metis sep_disj_option(1) times_option(1))

lemma apply_Module_Distr_HomoS_LCond:
  Module_Distr_HomoS F Ds Dx uz
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (C  Ds s  Ds t  s ##+ t  Dx s t x) 
           ?+ True r = ?+ C s + ?+ True t
 x  F r 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?sL C (uz s t) x  ◒[C] F s  F t
  unfolding Premise_def Module_Distr_HomoS_def Transformation_def
  by (cases C; clarsimp; metis sep_disj_option(1) times_option(1))

lemma apply_Module_Distr_HomoS_rev:
  Module_Distr_HomoS F Ds Dx' uz'
 Module_Distr_HomoS_rev F Dx' uz' Ds Dx uz
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds s  Ds t  t ##+ s  Dx s t x
 x  F (t + s) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 uz s t x  F s  F t
  unfolding Module_Distr_HomoS_rev_def Premise_def
  by blast


subsubsection ‹Swap \& Assoc Normalization›

φreasoner_group φToA_SA_norm = (1000, [10,2000]) in φsimp_all
      ‹normalize the φ-type by swapping, as that specified by ‹φToA_swap_normalization››
  and φToA_SA_derived = (50, [50, 50]) in φsimp_derived and in φToA_SA_norm
                                              and > φsimp_derived_Tr_functor
      ‹derived›


ML_file ‹library/phi_type_algebra/commutativity.ML›
(*ML_file ‹library/phi_type_algebra/weight.ML›*)

definition Require_Swap_Norm :: ('c,'a) φ  bool
  where Require_Swap_Norm F_G_T  True
    ― ‹a pure syntactical checking for whether F› should be swapped into G›, in F(G(T))›,
        or any multi-arity version›

definition Not_Require_Swap_Norm :: ('c,'a) φ  bool
  where Not_Require_Swap_Norm F_G_T  True

definition Require_Assoc_Norm :: ('c,'a) φ  bool  bool
  where Require_Assoc_Norm F_G_T direction  True
  ― ‹direction = True› for using intro rules only ; False› for elim rules only›

definition Not_Require_Assoc_Norm :: ('c,'a) φ  bool  bool
  where Not_Require_Assoc_Norm F_G_T direction  True

definition Require_SA_Norm :: ('c,'a) φ  bool  bool
  where Require_SA_Norm F_G_T direction  Require_Swap_Norm F_G_T  Require_Assoc_Norm F_G_T direction

definition Not_Require_SA_Norm :: ('c,'a) φ  bool  bool
  where Not_Require_SA_Norm F_G_T direction  Not_Require_Swap_Norm F_G_T  Not_Require_Assoc_Norm F_G_T direction
  

φreasoner_ML Require_Swap_Norm %cutting (Require_Swap_Norm _) = fn (_, (ctxt,sequent)) => Seq.make (fn () =>
  let val (bvs, F_G_T) =
        case Phi_Help.strip_meta_hhf_bvs (Phi_Help.leading_antecedent' sequent)
          of (bvtys, _ (*Trueprop*) $ (Const _ (*Require_Swap_Norm*) $ F_G_T)) =>
             (bvtys, F_G_T)
   in if Phi_Type.whether_to_swap_normalize (Context.Proof ctxt) bvs F_G_T
      then SOME ((ctxt, @{lemma' Require_Swap_Norm F by (simp add: Require_Swap_Norm_def)} RS sequent), Seq.empty)
      else NONE
  end)

φreasoner_ML Not_Require_Swap_Norm %cutting (Not_Require_Swap_Norm _) = fn (_, (ctxt,sequent)) => Seq.make (fn () =>
  let val (bvs, F_G_T) =
        case Phi_Help.strip_meta_hhf_bvs (Phi_Help.leading_antecedent' sequent)
          of (bvtys, _ (*Trueprop*) $ (Const _ (*Not_Require_Swap_Norm*) $ F_G_T)) =>
             (bvtys, F_G_T)
   in if Phi_Type.whether_to_swap_normalize (Context.Proof ctxt) bvs F_G_T
      then NONE
      else SOME ((ctxt, @{lemma' Not_Require_Swap_Norm F by (simp add: Not_Require_Swap_Norm_def)} RS sequent), Seq.empty)
  end)

φreasoner_ML Require_Assoc_Norm %cutting (Require_Assoc_Norm _ _) = fn (_, (ctxt,sequent)) => Seq.make (fn () =>
  let val (bvs, F_G_T, direction) =
        case Phi_Help.strip_meta_hhf_bvs (Phi_Help.leading_antecedent' sequent)
          of (bvtys, _ (*Trueprop*) $ (Const _ (*Require_Swap_Norm*) $ F_G_T $ direction)) =>
             (bvtys, F_G_T, (case direction of ConstTrue => Phi_Type.AD_INTRO
                                             | ConstFalse => Phi_Type.AD_ELIM
                                             | _ => raise TERM ("Bad direction of Require_Assoc_Norm", [direction])))
   in if Phi_Type.whether_to_assoc_normalize (Context.Proof ctxt) direction bvs F_G_T
      then SOME ((ctxt, @{lemma' Require_Assoc_Norm F Any by (simp add: Require_Assoc_Norm_def)} RS sequent), Seq.empty)
      else NONE
  end)

φreasoner_ML Not_Require_Assoc_Norm %cutting (Not_Require_Assoc_Norm _ _) = fn (_, (ctxt,sequent)) => Seq.make (fn () =>
  let val (bvs, F_G_T, direction) =
        case Phi_Help.strip_meta_hhf_bvs (Phi_Help.leading_antecedent' sequent)
          of (bvtys, _ (*Trueprop*) $ (Const _ (*Require_Swap_Norm*) $ F_G_T $ direction)) =>
             (bvtys, F_G_T, (case direction of ConstTrue => Phi_Type.AD_INTRO
                                             | ConstFalse => Phi_Type.AD_ELIM
                                             | _ => raise TERM ("Bad direction of Require_Assoc_Norm", [direction])))
   in if Phi_Type.whether_to_assoc_normalize (Context.Proof ctxt) direction bvs F_G_T
      then NONE
      else SOME ((ctxt, @{lemma' Not_Require_Assoc_Norm F Any by (simp add: Not_Require_Assoc_Norm_def)} RS sequent), Seq.empty)
  end)

φreasoner_ML Require_SA_Norm %cutting (Require_SA_Norm _ _) = fn (_, (ctxt,sequent)) => Seq.make (fn () =>
  let val (bvs, F_G_T, direction) =
        case Phi_Help.strip_meta_hhf_bvs (Phi_Help.leading_antecedent' sequent)
          of (bvtys, _ (*Trueprop*) $ (Const _ (*Require_Swap_Norm*) $ F_G_T $ direction)) =>
             (bvtys, F_G_T, (case direction of ConstTrue => Phi_Type.AD_INTRO
                                             | ConstFalse => Phi_Type.AD_ELIM
                                             | _ => raise TERM ("Bad direction of Require_SA_Norm", [direction])))
   in if Phi_Type.whether_to_SA_normalize (Context.Proof ctxt) direction bvs F_G_T
      then SOME ((ctxt, @{lemma' Require_SA_Norm F Any
                             by (simp add: Require_SA_Norm_def Require_Assoc_Norm_def )} RS sequent), Seq.empty)
      else NONE
  end)

φreasoner_ML Not_Require_SA_Norm %cutting (Not_Require_SA_Norm _ _) = fn (_, (ctxt,sequent)) => Seq.make (fn () =>
  let val (bvs, F_G_T, direction) =
        case Phi_Help.strip_meta_hhf_bvs (Phi_Help.leading_antecedent' sequent)
          of (bvtys, _ (*Trueprop*) $ (Const _ (*Require_Swap_Norm*) $ F_G_T $ direction)) =>
             (bvtys, F_G_T, (case direction of ConstTrue => Phi_Type.AD_INTRO
                                             | ConstFalse => Phi_Type.AD_ELIM
                                             | _ => raise TERM ("Bad direction of Not_Require_SA_Norm", [direction])))
   in if Phi_Type.whether_to_SA_normalize (Context.Proof ctxt) direction bvs F_G_T
      then NONE
      else SOME ((ctxt, @{lemma' Not_Require_SA_Norm F Any
                             by (simp add: Not_Require_SA_Norm_def Not_Require_Assoc_Norm_def Not_Require_Swap_Norm_def )}
                        RS sequent), Seq.empty)
  end)


subsection ‹Programming Methods to Prove the Properties›


subsubsection ‹Transformation Functor›

lemma [φreason %φprogramming_method]:
  PROP φProgramming_Method (x g.
            a  D x. a  T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U 𝗌𝗎𝖻𝗃 b. g a b
         𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (a b. a  D x  g a b  b  R x)
         x  F1 T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  F2 U 𝗌𝗎𝖻𝗃 y. mapper g x y) MM DD RR FF
 PROP φProgramming_Method (Trueprop (Transformation_Functor F1 F2 T U D R mapper)) MM DD RR FF
  unfolding φProgramming_Method_def Transformation_Functor_def Premise_def
  by clarsimp

lemma [φreason %φprogramming_method]:
  PROP φProgramming_Method (x g1 g2.
            a  D1 x. a  T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U1 𝗌𝗎𝖻𝗃 b. g1 a b
         a  D2 x. a  T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U2 𝗌𝗎𝖻𝗃 b. g2 a b
         𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (a b. a  D1 x  g1 a b  b  R1 x)  (a b. a  D2 x  g2 a b  b  R2 x)
         x  F1 T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  F2 U1 U2 𝗌𝗎𝖻𝗃 y. mapper g1 g2 x y) MM DD RR FF
 PROP φProgramming_Method (Trueprop (Transformation_BiFunctor F1 F2 T1 T2 U1 U2 D1 D2 R1 R2 mapper)) MM DD RR FF
  unfolding φProgramming_Method_def Transformation_BiFunctor_def Premise_def
            Transformation_def
  by (simp add: atomize_imp atomize_all)


subsubsection ‹Separation Homo›

(* TODO
lemma
  ‹ PROP φProgramming_Method (⋀T U x g.
            ∀a ∈ D x. a ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U 𝗌𝗎𝖻𝗃 b. g a b
        ⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀a b. a ∈ D x ∧ g a b ⟶ b ∈ R x)
        ⟹ x ⦂ F1 T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ F2 U 𝗌𝗎𝖻𝗃 y. mapper g x y) MM DD RR FF
⟹ PROP φProgramming_Method (Trueprop (Separation_HomoI Ft Fu Fc D R mapper)) MM DD RR FF › *)


subsubsection ‹Semimodule Functor›

lemma [φreason %φprogramming_method]:
  PROP φProgramming_Method (s t x y.
              𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds s  Ds t  s ##+ t  Dx s t (x,y)
           (x  F s) * (y  F t) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z s t (x,y)  F (s + t)
        ) MM DD RR FF
 PROP φProgramming_Method (Trueprop (Module_Distr_HomoZ F Ds Dx z)) MM DD RR FF
  unfolding φProgramming_Method_def Module_Distr_HomoZ_def Premise_def norm_hhf_eq
  by (clarsimp simp add: φProd_expn')

(* all be deduced from ‹Module_Distr_HomoZ› and no need to go to programming
lemma [φreason %φprogramming_method]:
  ‹ PROP φProgramming_Method (⋀s t x y.
              𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds t ∧ Ds s ∧ t ##+ s ∧ Dx t s (x,y)
          ⟹ (y ⦂ F s T) * (x ⦂ F t T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z t s (x,y) ⦂ F (t + s) T
        ) MM DD RR FF
⟹ PROP φProgramming_Method (Trueprop (Module_Distr_HomoZ_rev F T Ds Dx z)) MM DD RR FF›
  unfolding φProgramming_Method_def Module_Distr_HomoZ_rev_def Premise_def norm_hhf_eq
  by (clarsimp simp add: φProd_expn')
*)

lemma [φreason %φprogramming_method]:
  PROP φProgramming_Method (s t x.
              𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds s  Ds t  s ##+ t  Dx s t x
           x  F (s + t) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 uz s t x  F s  F t
        ) MM DD RR FF
 PROP φProgramming_Method (Trueprop (Module_Distr_HomoS F Ds Dx uz)) MM DD RR FF
  unfolding φProgramming_Method_def Module_Distr_HomoS_def Premise_def norm_hhf_eq
  by (clarsimp simp add: φProd_expn')

(* all be deduced from ‹Module_Distr_HomoZ› and no need to go to programming
lemma [φreason %φprogramming_method]:
  ‹ PROP φProgramming_Method (⋀s t x.
              𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds s ∧ Ds t ∧ s ##+ t ∧ Dx s t x
          ⟹ x ⦂ F (s + t) T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 uz s t x ⦂ F s T ∗ F t T
        ) MM DD RR FF
⟹ PROP φProgramming_Method (Trueprop (Module_Distr_HomoS_rev F T Ds Dx uz)) MM DD RR FF›
  unfolding φProgramming_Method_def Module_Distr_HomoS_rev_def Premise_def norm_hhf_eq
  by (clarsimp simp add: φProd_expn')
*)



section ‹Definition and Deriving Tools for φ-Types›

text ‹The @{command φtype_def} command always generate 4 sorts of rules.
  For instance, for definition x ⦂ T ≡ U›,

 ‹T.intro› of form propU 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x  T. There are corresponding reasoning rules named ‹T.intro_reasoning›.
      By default the reasoning rules are not activated. You may activate them by
      ‹declare T.intro_reasoning[φreason]› in order to, for instance, reduce to U› the reasoning of
      ‹every› transformation goal targeting to T›. Depending on the priority you configured,
      if the priority is greater than 54 (the priority of the entry point of the Structural Extraction),,
      this reduction happens before any in-depth reasoning that collects proportions in the source
      objects to synthesis the target T› (i.e. the Structural Extraction, SE);
      if the priority is less than 50, it serves as a fallback when the SE fails.

      In any case even if you do not activate the intro rule, the system always activates a rule
      that allows you to use termMAKE T tag to invoke the intro rule and to make a φ-type term
      of T› from U›. To use it, just write φ-Lang ‹‹x ⦂ MAKE T›› to invoke the synthesis process.

 ‹T.elim› of form propx  T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U. There are also corresponding reasoning rules named ‹T.elim_reasoning›.
      They are also not activated by default. The priority of them can be more arbitrary because they are
      in the SE process as the last stage of the ∃free-ToA reasoning. Note the ∃free-ToA reasoning
      works not good if the elim rule introduces existential quantification, because the ∃free-ToA
      by design does not consider opening abstraction.

      No matter if the reasoning rules are activated, you can always open an abstraction using
      To-Transformation, i.e., φ-Lang ‹to ‹List OPEN›› for instance to open x" ⦂ List T› into
      { y" ⦂ List U' | List.rel P x" y" }› if U ≡ { y ⦂ U' | P y }› for some y› and y"› that
      maybe in a set if x ⦂ T› is an abstraction of a set of  { y ⦂ U' | P y } ›.

 ‹T.unfold›, prop(x  T) = U

 ‹T.expansion›, propp  (x  T)  p  U. This rule is added to the system global simplifier.

If a definition like those recursive definitions is characterized by multiple equations.
The above rules are generated for each equation correspondingly.
›

subsection ‹Implementation›

paragraph ‹Templates Generating Rules›

(*
lemma φinductive_destruction_rule_from_direct_definition:
  ‹ (x ⦂ T) = U
⟹ P ⟶ (R * U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 Q)
⟹ P ⟶ (R * (x ⦂ T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 Q) ›
  by simp

lemma φinductive_destruction_rule_from_direct_definition':
  ‹ (x ⦂ T) = U
⟹ P ⟶ (U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 Q)
⟹ P ⟶ (x ⦂ T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 Q) ›
  by simp
*)

subparagraph ‹Intro and Elim reasoning rules›

lemma φintro_transformation:
  (x  T) = U
 U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x  T
  by simp

lemma φintro_reasoning_transformation:
  (x  T) = U
 A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U 𝗐𝗂𝗍𝗁 P
 A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x  T 𝗐𝗂𝗍𝗁 P
  by simp

text ‹The generated intro-rule is in x ⦂ T ∗[C] R› form to the best which is the most general
      and falls back to x ⦂ T 𝗋𝖾𝗆𝖺𝗂𝗇𝗌[C] R› if the definition cannot be rewrote to type form x ⦂ T ≡ y ⦂ U›.

Priorities: φintro'_reasoning_transformation_ty_var› >
            φintro'_reasoning_transformation_ty› >
            φintro'_reasoning_transformation›

lemma φintro'_reasoning_transformation:
  (x  T) = U
 A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 R 𝗐𝗂𝗍𝗁 P
 A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x  T 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 R 𝗐𝗂𝗍𝗁 P
  by simp

lemma φintro'_reasoning_transformation_ty:
  (x  T) = (y  U)
 A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 yr  U  R 𝗐𝗂𝗍𝗁 P
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 fst yr = y
 A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (x, snd yr)  T  R 𝗐𝗂𝗍𝗁 P
  unfolding Premise_def φProd'_def
  by (cases yr; simp add: φProd_expn')

lemma φelim_transformation:
  (x  T) = U
 x  T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 U
  by simp

lemma φelim_reasoning_transformation:
  (x  T) = U
 U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
 x  T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
  by simp

lemma φelim'SEi_transformation:
  (x. (x  T) = (y x  U x))
 (y (fst x), snd x)  U (fst x)  W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
 x  T  W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P
  by (cases x; simp add: φProd_expn' φProd'_def)


lemma φintro_ToA_Mapper_template:
  (x. (x  T ) = (ψ  x  S ))
 (x. (x  T') = (ψ' x  S'))
 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (x(f o ψ) `D. ψ' (φ' x) = x)
 𝗆𝖺𝗉 g : U  U' 𝗈𝗏𝖾𝗋 f : S  S' 𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s 𝗂𝗇 ψ ` D
 𝗆𝖺𝗉 g : U  U' 𝗈𝗏𝖾𝗋 φ' o f o ψ : T  T' 𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h o ψ 𝗌𝖾𝗍𝗍𝖾𝗋 φ' o s 𝗂𝗇 D
  unfolding ToA_Mapper_def Premise_def
  by clarsimp

lemma φintro_ToA_Mapper_template_SE:
  (x. (x  T ) = (ψ  x  S ))
 (x. (x  T') = (ψ' x  S'))
 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (x(f o ψ o fst) `D. ψ' (φ' x) = x)
 𝗆𝖺𝗉 g : U  U' 𝗈𝗏𝖾𝗋 f f w : S  W  S'  W' 𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s 𝗂𝗇 apfst ψ ` D
 𝗆𝖺𝗉 g : U  U' 𝗈𝗏𝖾𝗋 (φ' o f o ψ) f w : T  W  T'  W' 𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h o apfst ψ 𝗌𝖾𝗍𝗍𝖾𝗋 apfst φ' o s 𝗂𝗇 D
  unfolding ToA_Mapper_rev_def Premise_def φProd'_def
  apply (clarsimp simp: φProd_expn' φProd_expn'' ball_conj_distrib[symmetric])
  subgoal premises prems for a b
    by (insert prems(1,2,5) prems(3,4)[THEN bspec[where x=(a,b)], OF (a, b)  D],
        auto simp: φProd_expn' φProd_expn'') .

lemma φelim_ToA_Mapper_template:
  (x. (x  U ) = (ψ  x  S ))
 (x. (x  U') = (ψ' x  S'))
 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (xh `D. ψ (φ x) = x)
 𝗆𝖺𝗉 ψ' o g o φ : S  S' 𝗈𝗏𝖾𝗋 f : T  T' 𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s 𝗂𝗇 D
 𝗆𝖺𝗉 g : U  U' 𝗈𝗏𝖾𝗋 f : T  T' 𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 φ o h 𝗌𝖾𝗍𝗍𝖾𝗋 s o ψ' 𝗂𝗇 D
  unfolding ToA_Mapper_def Premise_def
  by clarsimp

lemma φelim_ToA_Mapper_template_SE:
  (x. (x  U ) = (ψ  x  S ))
 (x. (x  U') = (ψ' x  S'))
 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (xfst ` h `D. ψ (φ x) = x)
 𝗆𝖺𝗉 (ψ' o g o φ) f r : S  R  S'  R' 𝗈𝗏𝖾𝗋 f : T  T' 𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s 𝗂𝗇 D
 𝗆𝖺𝗉 g f r : U  R  U'  R' 𝗈𝗏𝖾𝗋 f : T  T' 𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 apfst φ o h 𝗌𝖾𝗍𝗍𝖾𝗋 s o apfst ψ' 𝗂𝗇 D
  unfolding ToA_Mapper_rev_def Premise_def φProd'_def
  apply (clarsimp simp: φProd_expn' φProd_expn'' ball_conj_distrib[symmetric])
  subgoal premises prems for x
    by (insert prems(1,2,5) prems(3,4)[THEN bspec[where x=x], OF x  D],
        auto simp: φProd_expn' φProd_expn'' prod.map_beta) .




subparagraph ‹OPEN and MAKE›

text ‹No Object_Equiv› is used and we use (=)› directly because we are destructing or constructing
  a φ-type abstraction by its definition where the definition covers every cases covered by the
  Object_Equiv›, so there is no need to apply Object_Equiv› any more.›

lemma φopen_abstraction_infer:
  (x  T) = R
 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 x' = x
 x'  T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 R @tag OPEN var 𝒯𝒫
  unfolding Action_Tag_def Simplify_def 𝗋Guard_def Premise_def
  by simp

lemma φopen_abstraction_specified:
  (x  T) = R
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x' = x
 x'  T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 R @tag OPEN i 𝒯𝒫
  unfolding Action_Tag_def Simplify_def 𝗋Guard_def Premise_def
  by simp

lemma φopen_abstraction_ty:
  (x  T) = (y  U)
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x' = x
 x'  T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  U @tag OPEN i 𝒯𝒫'
  unfolding Action_Tag_def Simplify_def 𝗋Guard_def Premise_def
  by simp

lemma φmake_abstraction_infer:
  (x  T) = U
 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 x = x'
 U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x'  T @tag MAKE var 𝒯𝒫
  unfolding Object_Equiv_def Premise_def Transformation_def 𝗋Guard_def Ant_Seq_def
            Orelse_shortcut_def Action_Tag_def
  by clarsimp

lemma φmake_abstraction_specified:
  (x  T) = U
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x = x'
 U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x'  T @tag MAKE i 𝒯𝒫
  unfolding Object_Equiv_def Premise_def Transformation_def 𝗋Guard_def Ant_Seq_def
            Orelse_shortcut_def Action_Tag_def
  by clarsimp


lemma φmake_abstraction_ty:
  (x  T) = (y  U)
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 y' = y
 y'  U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x  T @tag MAKE i 𝒯𝒫'
  unfolding Action_Tag_def Premise_def
  by simp


(*
lemma φmake_Identity_ElementE:
  ‹ (x ⦂ T) = U
⟹ Identity_ElementE U
⟹ Identity_ElementE (x ⦂ MAKE T) ›
  unfolding MAKE_def
  by simp
*)

lemma φgen_expansion:
  (x  T) = U
 p  (x  T)  p  U
  by simp

lemma φunfold_val:
  (x  T) = (y  U)
 (x  𝗏𝖺𝗅[v] T) = (y  𝗏𝖺𝗅[v] U)
  unfolding Val_def BI_eq_iff φType_def
  by auto

φreasoner_group all_derived_rules = (100, [0,999999]) ‹A group collecting all derived rules›

ML_file ‹library/phi_type_algebra/typ_def.ML›

(*TODO: move*)

consts under_φderiving :: mode

φreasoner_ML under_φderiving %cutting (True @tag under_φderiving) = fn (_, (ctxt,sequent)) => Seq.make (fn () =>
      if Config.get ctxt Phi_Type.under_deriving_ctxt
      then SOME ((ctxt, @{lemma' True @tag under_φderiving
                             by (simp add: Action_Tag_def)} RS sequent), Seq.empty)
      else NONE)

φreasoner_ML Premise under_φderiving %cutting (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[under_φderiving] _) = fn (_, (ctxt, sequent)) => Seq.make (fn () =>
      if Config.get ctxt Phi_Type.under_deriving_ctxt
      then SOME ((ctxt, @{lemma' 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 P  𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[under_φderiving] P
                             by (simp add: Premise_def)} RS sequent), Seq.empty)
      else SOME ((ctxt, @{lemma' 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 P  𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[under_φderiving] P
                             by (simp add: Premise_def)} RS sequent), Seq.empty))

lemma [φreason %extract_pure]:
  𝗋EIF (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[under_φderiving] P) P
  unfolding 𝗋EIF_def Premise_def
  by blast

lemma [φreason %extract_pure]:
  𝗋ESC P (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[under_φderiving] P)
  unfolding 𝗋ESC_def Premise_def
  by blast


hide_fact φintro_transformation φintro_reasoning_transformation φintro'_reasoning_transformation
          φintro'_reasoning_transformation_ty φelim_transformation φelim_reasoning_transformation
          φelim'SEi_transformation φintro_ToA_Mapper_template 


subsection ‹Instances for Predefined Basic φ-Types›

text ‹The section manually gives property instances of predefined basic φ-types and any later φ-types
      are defined using φ-type definition tools and their property instances are derived by derivers.

  Though the property instances of the basic φ-types are given manually here, it does not mean they
  are primitive and cannot be derived automatically. It is just engineeringly, the types are bootstraps
  given very early in the initiation process of the system, so have no chance to enjoy the automation of
  deriver tools and because some properties of them are given manually early, the remaining properties
  also cannot be configured using the deriver tool otherwise clashes happen.
›



section ‹Applications of the Algebraic Properties in Reasoning›

subsection ‹Vary Type Operator among Instantiations›

definition Type_Variant_of_the_Same_Type_Operator
        :: ('a  ('b,'c) φ)  ('a2  ('b2,'c2) φ)  bool
  where Type_Variant_of_the_Same_Type_Operator Fa Fb  True
  ― ‹Fa and Fb are the same functor having identical parameters but of different type instantiations.
      We use this to simulate the Λ operator in system-F›

definition Type_Variant_of_the_Same_Type_Operator2
        :: ('s  'a  ('b,'c) φ)  ('s2  'a2  ('b2,'c2) φ)  bool
  where Type_Variant_of_the_Same_Type_Operator2 Fa Fb  True
  ― ‹While Type_Variant_of_the_Same_Type_Operator› considers the φ-type as a type operator
      over each of its parameters, e.g., λA. F A B C› λB. F A B C› λC. F A B C› for F A B C›,
      the Type_Variant_of_the_Same_Type_Operator2› only considers the given φ-type as a binary type
      operator over its last two parameters, e.g., only λB C. F A B C›.
     This is for performance. For other interpretations, user may provide the rule of
      Type_Variant_of_the_Same_Type_Operator2› manually.›

definition Type_Variant_of_the_Same_Scalar_Mul0
        :: ('s  ('b,'c) φ)  ('s2  ('b2,'c2) φ)  bool
  where Type_Variant_of_the_Same_Scalar_Mul0 Fa Fb  True

definition Type_Variant_of_the_Same_Scalar_Mul
        :: ('s  'a  ('b,'c) φ)  ('s2  'a2  ('b2,'c2) φ)  bool
  where Type_Variant_of_the_Same_Scalar_Mul Fa Fb  True

definition Parameter_Variant_of_the_Same_Type :: 'a  'b  bool
  where Parameter_Variant_of_the_Same_Type Fa Fb  True
  ― ‹Every parameter together with any types is differentiated›

definition Parameter_Variant_of_the_Same_TypOpr
        :: ('p  ('a,'b) φ)  ('p2  ('c,'d) φ)  bool
  where Parameter_Variant_of_the_Same_TypOpr Fa Fb  True
  ― ‹Every parameter together with any types is differentiated›

declare [[
  φreason_default_pattern
      Type_Variant_of_the_Same_Type_Operator ?Fa ?Fb 
      Type_Variant_of_the_Same_Type_Operator ?Fa _
      Type_Variant_of_the_Same_Type_Operator _ ?Fb    (100)
  and Type_Variant_of_the_Same_Type_Operator2 ?Fa ?Fb 
      Type_Variant_of_the_Same_Type_Operator2 ?Fa _
      Type_Variant_of_the_Same_Type_Operator2 _ ?Fb   (100)
  and Type_Variant_of_the_Same_Scalar_Mul ?Fa ?Fb 
      Type_Variant_of_the_Same_Scalar_Mul ?Fa _
      Type_Variant_of_the_Same_Scalar_Mul _ ?Fb       (100)
  and Type_Variant_of_the_Same_Scalar_Mul0 ?Fa ?Fb 
      Type_Variant_of_the_Same_Scalar_Mul0 ?Fa _
      Type_Variant_of_the_Same_Scalar_Mul0 _ ?Fb      (100)
  and Parameter_Variant_of_the_Same_Type ?Fa ?Fb 
      Parameter_Variant_of_the_Same_Type ?Fa _
      Parameter_Variant_of_the_Same_Type _ ?Fb        (100)
  and Parameter_Variant_of_the_Same_TypOpr ?Fa ?Fb 
      Parameter_Variant_of_the_Same_TypOpr ?Fa _
      Parameter_Variant_of_the_Same_TypOpr _ ?Fb        (100)
  (*and ‹Parameter_Variant_of_the_Same_Type1 ?Fa _› ⇒ ‹Parameter_Variant_of_the_Same_Type1 ?Fa _› (100)*)
  
  (* φpremise_attribute? [φreason add] for ‹Type_Variant_of_the_Same_Type_Operator _ _› *)
  (* φpremise_attribute? [φreason add] for ‹Parameter_Variant_of_the_Same_Type _ _› *)
]]

φreasoner_group variants_of_type_opr = (%cutting, [%cutting, %cutting])
    for (Type_Variant_of_the_Same_Type_Operator F F',
         Type_Variant_of_the_Same_Type_Operator2 F F',
         Type_Variant_of_the_Same_Scalar_Mul0 F F',
         Type_Variant_of_the_Same_Scalar_Mul F F',
         Parameter_Variant_of_the_Same_Type F F')
    ‹variants_of_type_opr›
  and variants_of_type_opr_overrided = (%cutting+10, [%cutting+10, %cutting+10]) > variants_of_type_opr ‹›

(*
lemma Parameter_Variant_of_the_Same_Type_I [φreason 1]:
  ‹Parameter_Variant_of_the_Same_Type Fa Fb›
  unfolding Parameter_Variant_of_the_Same_Type_def .. *)

lemma Type_Variant_of_the_Same_Type_Operator_I:
  Type_Variant_of_the_Same_Type_Operator Fa Fb
  unfolding Type_Variant_of_the_Same_Type_Operator_def ..

lemma Type_Variant_of_the_Same_Type_Operator2_I:
  Type_Variant_of_the_Same_Type_Operator2 Fa Fb
  unfolding Type_Variant_of_the_Same_Type_Operator2_def ..

lemma Type_Variant_of_the_Same_Scalar_Mul_I:
  Type_Variant_of_the_Same_Scalar_Mul Fa Fb
  unfolding Type_Variant_of_the_Same_Scalar_Mul_def ..

lemma Type_Variant_of_the_Same_Scalar_Mul0_I:
  Type_Variant_of_the_Same_Scalar_Mul0 Fa Fb
  unfolding Type_Variant_of_the_Same_Scalar_Mul0_def ..

lemma Type_Variant_of_the_Same_Scalar_Mul0_I':
  Type_Variant_of_the_Same_Scalar_Mul0 (λs. Fa s T) (λs. Fb s U)
  unfolding Type_Variant_of_the_Same_Scalar_Mul0_def ..

                    
ML_file ‹library/phi_type_algebra/variant_phi_type_instantiations.ML›

setup PLPR_Template_Properties.add_property_kinds [
    pattern_propType_Variant_of_the_Same_Type_Operator _ _,
    pattern_propType_Variant_of_the_Same_Type_Operator2 _ _,
    pattern_propType_Variant_of_the_Same_Scalar_Mul _ _,
    pattern_propType_Variant_of_the_Same_Scalar_Mul0 _ _,
    pattern_propParameter_Variant_of_the_Same_Type _ _,
    pattern_propParameter_Variant_of_the_Same_TypOpr _ _
  (*pattern_prop‹Parameter_Variant_of_the_Same_Type1 _ _›*)
  ]

φreasoner_ML Parameter_Variant_of_the_Same_Type %variants_of_type_opr_overrided (Parameter_Variant_of_the_Same_Type _ ?var) = fn (_, (ctxt, sequent)) => Seq.make (fn () =>
    let val (bvtys, goal) = Phi_Help.strip_meta_hhf_bvtys (Phi_Help.leading_antecedent' sequent)
        val _ (*Trueprop*) $ (_ (*Parameter_Variant_of_the_Same_Type*) $ LHS $ var) = goal
        val thy = Proof_Context.theory_of ctxt
        val (Var (v, _), bargs) = strip_comb var
        val barg_tys = map (fn x => fastype_of1 (bvtys, x)) bargs
        exception Not_A_Phi_Type
        fun parse lv bvs (X $ Bound i) =
              if i < lv then parse lv (SOME i :: bvs) X else parse lv (NONE :: bvs) X
          | parse lv bvs (X $ Y) = parse lv (NONE :: bvs) X
          | parse lv bvs (Abs(_,_,X)) = parse (lv+1) (map (Option.map (fn i=>i+1)) bvs) X
          | parse lv bvs (Const(N, _)) =
              let val idx = Thm.maxidx_of sequent + 1
                  val ty = Logic.incr_tvar idx (Sign.the_const_type thy N )
                  val args = List.take (Term.binder_types ty, length bvs)
                  val a_num = length args
                  val b_num = length barg_tys
                  val parameterize = fold_index (fn (i,_) => fn X => X $ Bound (a_num+b_num-1-i)) barg_tys
                  val const = Const(N, ty)
                  val (F0,bvs) = fold_index (
                        fn (_, (SOME b, ty)) => (fn (X,bvs) => (X $ Bound b, (b,ty)::bvs))
                         | (i, (NONE, ty)) => (fn (X,bvs) => (X $ parameterize (Var (("x",idx+i), barg_tys ---> ty)), bvs))
                      ) (bvs ~~ args) (const, [])
                  val F = fold_index (fn (i,_) => fn X =>
                            case AList.lookup (op =) bvs i
                              of SOME ty => Abs ("_", ty, X)
                               | NONE => raise Not_A_Phi_Type
                          ) bvs F0
                       |> fold_rev (fn ty => fn X => Abs ("_", ty, X)) barg_tys
                       |> Thm.cterm_of ctxt
               in Drule.infer_instantiate ctxt [(v, F)] sequent
               |> (fn th => @{lemma' Parameter_Variant_of_the_Same_Type A B
                                  by (simp add: Parameter_Variant_of_the_Same_Type_def)} RS th)
               |> (fn th => SOME ((ctxt,th), Seq.empty))
              end
     in parse 0 [] LHS
    end
)


subsection ‹Auxiliary›

definition SE_Has_or_Not
  where SE_Has_or_Not C W F FW  (if C then FW = F W else W =   FW = )

definition SE_Has_or_Not2
  where SE_Has_or_Not2 C W1 W2 F FW  (if C then FW = F W1 W2 else W1 =   W2 =   FW = )

definition SE_Has_or_NotΛ
  where SE_Has_or_NotΛ C W F FW  (if C then FW = F W else (a. W a = )  FW = )

φreasoner_group 
        SE_Has_or_Not_all = (100, [10,2000]) ‹›
    and SE_Has_or_Not = (1000, [1000,1030]) in SE_Has_or_Not_all ‹›
    and SE_Has_or_Not_default = (30, [10,50]) in SE_Has_or_Not_all ‹›

declare [[ φreason_default_pattern
      SE_Has_or_Not _ ?W ?F _  SE_Has_or_Not _ ?W ?F _ (100)
  and SE_Has_or_NotΛ _ ?W ?F _  SE_Has_or_NotΛ _ ?W ?F _ (100)
  and SE_Has_or_Not2 _ ?W1 ?W2 ?F _  SE_Has_or_Not2 _ ?W1 ?W2 ?F _ (100)
]]

lemma SE_Has_or_Not_alt_def:
  SE_Has_or_Not C W F FW  ◒[C] W = W  ◒[C] F W = FW
  unfolding SE_Has_or_Not_def
  by simp blast

lemma SE_Has_or_Not2_alt_def:
  SE_Has_or_Not2 C W1 W2 F FW  ◒[C] W1 = W1  ◒[C] W2 = W2  ◒[C] F W1 W2 = FW
  unfolding SE_Has_or_Not2_def
  by simp blast

lemma SE_Has_or_NotΛ_alt_def:
  SE_Has_or_NotΛ C W F FW  (a. ◒[C] W a = W a)  ◒[C] F W = FW
  unfolding SE_Has_or_NotΛ_def
  by simp fastforce

lemma SE_Has_or_Not_None[φreason %SE_Has_or_Not + 10]:
  SE_Has_or_Not False  F 
  unfolding SE_Has_or_Not_def
  by (simp add: φNone_def)

lemma SE_Has_or_NotΛ_None[φreason %SE_Has_or_Not + 10]:
  SE_Has_or_NotΛ False (λ_. ) F 
  unfolding SE_Has_or_NotΛ_def
  by (simp add: φNone_def)

lemma SE_Has_or_Not2_None[φreason %SE_Has_or_Not + 10]:
  SE_Has_or_Not2 False   F 
  unfolding SE_Has_or_Not2_def
  by (simp add: φNone_def)


lemma [φreason %SE_Has_or_Not]:
  SE_Has_or_Not True W F (F W)
  unfolding SE_Has_or_Not_def
  by simp

lemma [φreason %SE_Has_or_Not]:
  SE_Has_or_Not2 True W1 W2 F (F W1 W2)
  unfolding SE_Has_or_Not2_def
  by simp

lemma [φreason %SE_Has_or_Not]:
  SE_Has_or_NotΛ True W F (F W)
  unfolding SE_Has_or_NotΛ_def
  by simp

lemma [φreason default %SE_Has_or_Not_default]:
  SE_Has_or_Not C F W FW
 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 FW = FW'
 SE_Has_or_Not C F W FW'
  unfolding Premise_def
  by simp

lemma [φreason default %SE_Has_or_Not_default]:
  SE_Has_or_Not2 C F W1 W2 FW
 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 FW = FW'
 SE_Has_or_Not2 C F W1 W2 FW'
  unfolding Premise_def
  by simp
  
lemma [φreason default %SE_Has_or_Not_default]:
  SE_Has_or_NotΛ C F W FW
 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 FW = FW'
 SE_Has_or_NotΛ C F W FW'
  unfolding Premise_def
  by simp


subsection ‹Transformation Functor›

lemma [φreason_template name Fa.simp_cong [φsimp_cong]]:
  Transformation_Functor Fa Fa T U (λx. {x}) (λx. ) (λx. x)
 Transformation_Functor Fa Fa U T (λx. {x}) (λx. ) (λx. x)
 PROP NO_SIMP' ((x  T)  (x'  U))
 (x  Fa T)  (x'  Fa U)
  unfolding Transformation_Functor_def Transformation_def atomize_eq NO_SIMP'_def
  apply (auto simp add: BI_eq_iff)
  subgoal premises prems for xa
    using prems(1)[THEN spec[where x=x], THEN spec[where x=λ_ c. c = x'], simplified]
    using prems(3) prems(4) by blast
  subgoal premises prems for xa
    using prems(2)[THEN spec[where x=x'], THEN spec[where x=λ_ c. c = x], simplified]
    using prems(3) prems(4) by blast
  .


lemma transformation[φreason_template name Fa.transformation []]:
  𝗀𝗎𝖺𝗋𝖽 Transformation_Functor Fa Fb T U D R mapper
 (a  D x. a  T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U 𝗌𝗎𝖻𝗃 b. g a b)
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (a b. a  D x  g a b  b  R x)
 x  Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  Fb U 𝗌𝗎𝖻𝗃 y. mapper g x y
  unfolding meta_Ball_def Premise_def 𝗋Guard_def Transformation_Functor_def Action_Tag_def
  by clarsimp

lemma [φreason_template default %To_ToA_derived_Tr_functor name Fa.To_Transformation]:
  𝗀𝗎𝖺𝗋𝖽 Transformation_Functor Fa Fb T U D R mapper
 (a  D x. a  T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U 𝗌𝗎𝖻𝗃 b. g a b @tag to Z)
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (a b. a  D x  g a b  b  R x)
 x  Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  Fb U 𝗌𝗎𝖻𝗃 y. mapper g x y @tag to (Fb Z)
  unfolding Action_Tag_def 𝗋Guard_def
  using transformation[unfolded 𝗋Guard_def Action_Tag_def,
                       where Fa=Fa and Fb=Fb and D=D and R=R and mapper=mapper] .

lemma [φreason_template default %To_ToA_derived_Tr_functor_fuzzy name Fa.To_Transformation_fuzzy]:
  NO_SIMP (𝗀𝗎𝖺𝗋𝖽 NO_MATCH TYPE('caa) TYPE('c))
 𝗀𝗎𝖺𝗋𝖽 Transformation_Functor Fa Fb T U D R mapper
 (a  D x. a  T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U 𝗌𝗎𝖻𝗃 b. g a b @tag to Z)
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (a b. a  D x  g a b  b  R x)
 x  Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  Fb U 𝗌𝗎𝖻𝗃 y. mapper g x y @tag to Z
    <except-pattern> (XX::'caa BI) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 YY 𝗐𝗂𝗍𝗁 PP @tag to Z
  for Fa :: ('ca, 'aa) φ  ('c,'a) φ and Z :: ('caa, 'aaa) φ
  unfolding Action_Tag_def 𝗋Guard_def Except_Pattern_def
  using transformation[unfolded 𝗋Guard_def Action_Tag_def,
                       where Fa=Fa and Fb=Fb and D=D and R=R and mapper=mapper] .

lemma [φreason_template default %To_ToA_derived_Tr_functor name Fa.to_traverse]:
  𝗀𝗎𝖺𝗋𝖽 Transformation_Functor Fa Fb T U D R mapper
 (a  D x. a  T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U 𝗌𝗎𝖻𝗃 b. g a b @tag to (𝗍𝗋𝖺𝗏𝖾𝗋𝗌𝖾 Z))
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (a b. a  D x  g a b  b  R x)
 x  Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  Fb U 𝗌𝗎𝖻𝗃 y. mapper g x y @tag to (𝗍𝗋𝖺𝗏𝖾𝗋𝗌𝖾 Z)
  unfolding Action_Tag_def 𝗋Guard_def
  using transformation[unfolded 𝗋Guard_def Action_Tag_def,
                       where Fa=Fa and Fb=Fb and D=D and R=R and mapper=mapper] .

lemma [φreason_template name Fa.𝒜simp [φtransformation_based_simp default %φsimp_derived_Tr_functor no trigger]]:
  𝗀𝗎𝖺𝗋𝖽 Transformation_Functor Fa Fb T U D R mapper
 𝗀𝗎𝖺𝗋𝖽 (a  D x. (a  T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U 𝗌𝗎𝖻𝗃 b. g a b @tag 𝒜simp))
 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (a b. a  D x  g a b  b  R x)
 x  Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  Fb U 𝗌𝗎𝖻𝗃 y. mapper g x y @tag 𝒜_transitive_simp
  unfolding Action_Tag_def Premise_def 𝗋Guard_def
  using transformation[unfolded atomize_Ball Premise_def 𝗋Guard_def Action_Tag_def,
                       where Fa=Fa and Fb=Fb and D=D and R=R and mapper=mapper] .

lemma [φreason_template name Fa.𝒜backward_simp [φtransformation_based_backward_simp default %φsimp_derived_Tr_functor no trigger]]:
  𝗀𝗎𝖺𝗋𝖽 Transformation_Functor Fa Fb T U D R mapper
 𝗀𝗎𝖺𝗋𝖽 (a  D x. (a  T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U 𝗌𝗎𝖻𝗃 b. g a b @tag 𝒜backward_simp))
 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (a b. a  D x  g a b  b  R x)
 x  Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  Fb U 𝗌𝗎𝖻𝗃 y. mapper g x y @tag 𝒜_backward_transitive_simp
  unfolding Action_Tag_def Premise_def 𝗋Guard_def
  using transformation[unfolded atomize_Ball Premise_def 𝗋Guard_def Action_Tag_def,
                       where Fa=Fa and Fb=Fb and D=D and R=R and mapper=mapper] .

lemma [no_atp, φreason_template default %ToA_derived_one_to_one_functor name Fa.functional_transformation]:
  𝗀𝗎𝖺𝗋𝖽 Functional_Transformation_Functor Fa Fb T U D R pred_mapper func_mapper
 (a  D x. a  T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f a  U 𝗐𝗂𝗍𝗁 P a @tag 𝒯𝒫 )
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (a. a  D x  f a  R x) 
 x  Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 func_mapper f P x  Fb U 𝗐𝗂𝗍𝗁 pred_mapper f P x @tag 𝒯𝒫
  unfolding 𝗋Guard_def Action_Tag_def
  using apply_Functional_Transformation_Functor[unfolded Argument_def,
            where func_mapper=func_mapper and pred_mapper=pred_mapper] .


subsection ‹Bi-Transformation Functor›

lemma bitransformation[φreason_template name Fa.bitransformation []]:
  𝗀𝗎𝖺𝗋𝖽 Transformation_BiFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 mapper
 (a  D1 x. a  T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U1 𝗌𝗎𝖻𝗃 b. g1 a b)
 (a  D2 x. a  T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U2 𝗌𝗎𝖻𝗃 b. g2 a b)
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (a b. a  D1 x  g1 a b  b  R1 x)  (a b. a  D2 x  g2 a b  b  R2 x)
 x  Fa T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  Fb U1 U2  𝗌𝗎𝖻𝗃 y. mapper g1 g2 x y
  unfolding meta_Ball_def Premise_def 𝗋Guard_def Transformation_BiFunctor_def
            Transformation_def
  by clarsimp

(*
lemma CV_bitransformation[φreason_template name Fa.bitransformation []]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 CV_TrFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 mapper
⟹ (⋀a. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (∃b. g1 a b ∧ b ∈ D1 x) ⟹ a ⦂ U1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ T1 𝗌𝗎𝖻𝗃 b. g1 a b)
⟹ (⋀a ∈ D2 x. a ⦂ T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U2 𝗌𝗎𝖻𝗃 b. g2 a b)
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀a b. b ∈ D1 x ∧ g1 a b ⟶ a ∈ R1 x) ∧ (∀a b. a ∈ D2 x ∧ g2 a b ⟶ b ∈ R2 x)
⟹ x ⦂ Fa T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Fb U1 U2  𝗌𝗎𝖻𝗃 y. mapper g1 g2 x y›
  unfolding meta_Ball_def Premise_def 𝗋Guard_def CV_TrFunctor_def Transformation_def
  by clarsimp
*)

lemma [φreason_template default %To_ToA_derived_Tr_functor name Fa.To_BiTransformation]:
  𝗀𝗎𝖺𝗋𝖽 Transformation_BiFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 mapper
 (a  D1 x. a  T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U1 𝗌𝗎𝖻𝗃 b. g1 a b @tag to Z1)
 (a  D2 x. a  T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U2 𝗌𝗎𝖻𝗃 b. g2 a b @tag to Z2)
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (a b. a  D1 x  g1 a b  b  R1 x)  (a b. a  D2 x  g2 a b  b  R2 x)
 x  Fa T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  Fb U1 U2 𝗌𝗎𝖻𝗃 y. mapper g1 g2 x y @tag to (Fb Z1 Z2)
  unfolding Action_Tag_def 𝗋Guard_def
  using bitransformation[unfolded 𝗋Guard_def, where Fa=Fa and Fb=Fb and D1=D1 and D2=D2 and mapper=mapper] .

lemma [φreason_template default %To_ToA_derived_Tr_functor name Fa.to_bitraverse]:
  𝗀𝗎𝖺𝗋𝖽 Transformation_BiFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 mapper
 (a  D1 x. a  T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U1 𝗌𝗎𝖻𝗃 b. g1 a b @tag to (𝗍𝗋𝖺𝗏𝖾𝗋𝗌𝖾 Z1))
 (a  D2 x. a  T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U2 𝗌𝗎𝖻𝗃 b. g2 a b @tag to (𝗍𝗋𝖺𝗏𝖾𝗋𝗌𝖾 Z2))
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (a b. a  D1 x  g1 a b  b  R1 x)  (a b. a  D2 x  g2 a b  b  R2 x)
 x  Fa T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  Fb U1 U2 𝗌𝗎𝖻𝗃 y. mapper g1 g2 x y @tag to (𝗍𝗋𝖺𝗏𝖾𝗋𝗌𝖾 Fb Z1 Z2)
  unfolding Action_Tag_def 𝗋Guard_def
  using bitransformation[unfolded 𝗋Guard_def, where Fa=Fa and Fb=Fb and D1=D1 and D2=D2 and mapper=mapper] .

lemma [φreason_template name Fa.𝒜simp_bi [φtransformation_based_simp default %φsimp_derived_Tr_functor no trigger]]:
  𝗀𝗎𝖺𝗋𝖽 Transformation_BiFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 mapper
 𝗀𝗎𝖺𝗋𝖽 (a  D1 x. (a  T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U1 𝗌𝗎𝖻𝗃 b. g1 a b @tag 𝒜try_simp M1))
 𝗀𝗎𝖺𝗋𝖽 (a  D2 x. (a  T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U2 𝗌𝗎𝖻𝗃 b. g2 a b @tag 𝒜try_simp M2))
 𝗀𝗎𝖺𝗋𝖽 M1  M2
 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (a b. a  D1 x  g1 a b  b  R1 x)  (a b. a  D2 x  g2 a b  b  R2 x)
 x  Fa T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  Fb U1 U2 𝗌𝗎𝖻𝗃 y. mapper g1 g2 x y @tag 𝒜_transitive_simp
  unfolding Action_Tag_def Premise_def 𝗋Guard_def
  using bitransformation[unfolded atomize_Ball 𝗋Guard_def Premise_def, where Fa=Fa and Fb=Fb and D1=D1 and D2=D2 and mapper=mapper] .


lemma [φreason_template name Fa.𝒜backward_simp_bi [φtransformation_based_backward_simp default %φsimp_derived_Tr_functor no trigger]]:
  𝗀𝗎𝖺𝗋𝖽 Transformation_BiFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 mapper
 𝗀𝗎𝖺𝗋𝖽 (a  D1 x. (a  T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U1 𝗌𝗎𝖻𝗃 b. g1 a b @tag 𝒜try_backward_simp M1))
 𝗀𝗎𝖺𝗋𝖽 (a  D2 x. (a  T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U2 𝗌𝗎𝖻𝗃 b. g2 a b @tag 𝒜try_backward_simp M2))
 𝗀𝗎𝖺𝗋𝖽 M1  M2
 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (a b. a  D1 x  g1 a b  b  R1 x)  (a b. a  D2 x  g2 a b  b  R2 x)
 x  Fa T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  Fb U1 U2 𝗌𝗎𝖻𝗃 y. mapper g1 g2 x y @tag 𝒜_backward_transitive_simp
  unfolding Action_Tag_def Premise_def 𝗋Guard_def
  using bitransformation[unfolded atomize_Ball 𝗋Guard_def Premise_def, where Fa=Fa and Fb=Fb and D1=D1 and D2=D2 and mapper=mapper] .


lemma [no_atp, φreason_template default %ToA_derived_one_to_one_functor name Fa.functional_transformation]:
  𝗀𝗎𝖺𝗋𝖽 Functional_Transformation_BiFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 pred_mapper func_mapper
 (a  D1 x. a  T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f1 a  U1 𝗐𝗂𝗍𝗁 P1 a @tag 𝒯𝒫 )
 (a  D2 x. a  T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f2 a  U2 𝗐𝗂𝗍𝗁 P2 a @tag 𝒯𝒫 )
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (a. a  D1 x  f1 a  R1 x)  (a. a  D2 x  f2 a  R2 x)
 x  Fa T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 func_mapper f1 f2 P1 P2 x  Fb U1 U2 𝗐𝗂𝗍𝗁 pred_mapper f1 f2 P1 P2 x @tag 𝒯𝒫
  unfolding 𝗋Guard_def Action_Tag_def
  using apply_Functional_Transformation_BiFunctor[unfolded Argument_def,
            where func_mapper=func_mapper and pred_mapper=pred_mapper] .

(*
lemma [φreason_template name Fa.𝒜backward_simp_bi [φtransformation_based_backward_simp default %φsimp_derived_Tr_functor no trigger]]:
  ‹ 𝗀𝗎𝖺𝗋𝖽 CV_TrFunctor Fa Fb T1 T2 U1 U2 D1 D2 R1 R2 mapper
⟹ 𝗀𝗎𝖺𝗋𝖽 (∀a. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (∃b. g1 a b ∧ b ∈ D1 x)
            ⟶ (a ⦂ U1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ T1 𝗌𝗎𝖻𝗃 b. g1 a b @tag 𝒜backward_simp))
⟹ 𝗀𝗎𝖺𝗋𝖽 (∀a ∈ D2 x. (a ⦂ T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b ⦂ U2 𝗌𝗎𝖻𝗃 b. g2 a b @tag 𝒜backward_simp))
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (∀a b. b ∈ D1 x ∧ g1 a b ⟶ a ∈ R1 x) ∧ (∀a b. a ∈ D2 x ∧ g2 a b ⟶ b ∈ R2 x)
⟹ x ⦂ Fa T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y ⦂ Fb U1 U2 𝗌𝗎𝖻𝗃 y. mapper g1 g2 x y @tag 𝒜_backward_transitive_simp ›
  unfolding Action_Tag_def Premise_def 𝗋Guard_def atomize_imp
  using CV_bitransformation[unfolded atomize_Ball atomize_imp atomize_all 𝗋Guard_def Premise_def,
            where Fa=Fa and Fb=Fb and D1=D1 and D2=D2 and R1=R1 and R2=R2 and mapper=mapper] .
*)

lemma [no_atp, φreason_template default %ToA_derived_one_to_one_functor name Fa.functional_transformation]:
  𝗀𝗎𝖺𝗋𝖽 Fun_CV_TrFunctor Fa Fb T1 T2 U1 U2 D1 D2 FC1 R2 pred_mapper func_mapper
 (a. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 f1 a  D1 x  a  U1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f1 a  T1 𝗐𝗂𝗍𝗁 P1 a @tag 𝒯𝒫 )
 (a  D2 x. a  T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f2 a  U2 𝗐𝗂𝗍𝗁 P2 a @tag 𝒯𝒫 )
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 FC1 f1 x  (a. a  D2 x  f2 a  R2 x)
 x  Fa T1 T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 func_mapper f1 f2 P1 P2 x  Fb U1 U2 𝗐𝗂𝗍𝗁 pred_mapper f1 f2 P1 P2 x @tag 𝒯𝒫
  unfolding 𝗋Guard_def Action_Tag_def
  using apply_Functional_CV_BiFunctor[unfolded Argument_def,
            where func_mapper=func_mapper and pred_mapper=pred_mapper] .


subsection ‹Transformation Functor with Parameterization›

lemma transformationΛ[φreason_template name Fa.transformation []]:
  𝗀𝗎𝖺𝗋𝖽 Transformation_FunctorΛ Fa Fb T U D R mapper
 (p. a  D p x. a  T p 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U p 𝗌𝗎𝖻𝗃 b. g p a b)
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (p a b. a  D p x  g p a b  b  R p x)
 x  Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  Fb U 𝗌𝗎𝖻𝗃 y. mapper g x y
  unfolding meta_Ball_def Premise_def 𝗋Guard_def Transformation_FunctorΛ_def
  by clarsimp

lemma [φreason_template default %To_ToA_derived_Tr_functor name Fa.To_Transformation]:
  𝗀𝗎𝖺𝗋𝖽 Transformation_FunctorΛ Fa Fb T U D R mapper
 (p. a  D p x. a  T p 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U p 𝗌𝗎𝖻𝗃 b. g p a b @tag to (Z p))
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (p a b. a  D p x  g p a b  b  R p x)
 x  Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  Fb U 𝗌𝗎𝖻𝗃 y. mapper g x y @tag to (Fb Z)
  unfolding Action_Tag_def 𝗋Guard_def
  using transformationΛ[unfolded 𝗋Guard_def, where Fa=Fa and Fb=Fb and D=D and R=R and mapper=mapper] .

lemma [φreason_template default %To_ToA_derived_Tr_functor_fuzzy name Fa.To_Transformation_fuzzy]:
  NO_SIMP (𝗀𝗎𝖺𝗋𝖽 NO_MATCH TYPE('caa) TYPE('c))
 𝗀𝗎𝖺𝗋𝖽 Transformation_FunctorΛ Fa Fb T U D R mapper
 (p. a  D p x. a  T p 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U p 𝗌𝗎𝖻𝗃 b. g p a b @tag to Z)
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (p a b. a  D p x  g p a b  b  R p x)
 x  Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  Fb U 𝗌𝗎𝖻𝗃 y. mapper g x y @tag to Z
    <except-pattern> (XX::'caa BI) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 YY 𝗐𝗂𝗍𝗁 PP @tag to Z
  for Fa :: ('p  ('ca, 'aa) φ)  ('c,'a) φ and Z :: ('caa, 'aaa) φ
  unfolding Action_Tag_def 𝗋Guard_def Except_Pattern_def
  using transformationΛ[unfolded 𝗋Guard_def, where Fa=Fa and Fb=Fb and D=D and R=R and mapper=mapper] .

lemma [φreason_template default %To_ToA_derived_Tr_functor name Fa.to_traverse]:
  𝗀𝗎𝖺𝗋𝖽 Transformation_FunctorΛ Fa Fb T U D R mapper
 (p. a  D p x. a  T p 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U p 𝗌𝗎𝖻𝗃 b. g p a b @tag to (𝗍𝗋𝖺𝗏𝖾𝗋𝗌𝖾 Z))
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (p a b. a  D p x  g p a b  b  R p x)
 x  Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  Fb U 𝗌𝗎𝖻𝗃 y. mapper g x y @tag to (𝗍𝗋𝖺𝗏𝖾𝗋𝗌𝖾 Z)
  unfolding Action_Tag_def 𝗋Guard_def
  using transformationΛ[unfolded 𝗋Guard_def, where Fa=Fa and Fb=Fb and D=D and R=R and mapper=mapper] .

lemma [φreason_template name Fa.𝒜simp [φtransformation_based_simp default %φsimp_derived_Tr_functor no trigger]]:
  𝗀𝗎𝖺𝗋𝖽 Transformation_FunctorΛ Fa Fb T U D R mapper
 𝗀𝗎𝖺𝗋𝖽 (p. a  D p x. (a  T p 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U p 𝗌𝗎𝖻𝗃 b. g p a b @tag 𝒜simp))
 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (p a b. a  D p x  g p a b  b  R p x)
 x  Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  Fb U 𝗌𝗎𝖻𝗃 y. mapper g x y @tag 𝒜_transitive_simp
  unfolding Action_Tag_def Premise_def 𝗋Guard_def
  using transformationΛ[unfolded atomize_Ball atomize_all Premise_def 𝗋Guard_def, where Fa=Fa and Fb=Fb and D=D and R=R and mapper=mapper] .

lemma [φreason_template name Fa.𝒜backward_simp [φtransformation_based_backward_simp default %φsimp_derived_Tr_functor no trigger]]:
  𝗀𝗎𝖺𝗋𝖽 Transformation_FunctorΛ Fa Fb T U D R mapper
 𝗀𝗎𝖺𝗋𝖽 (p. a  D p x. (a  T p 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U p 𝗌𝗎𝖻𝗃 b. g p a b @tag 𝒜backward_simp))
 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (p a b. a  D p x  g p a b  b  R p x)
 x  Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  Fb U 𝗌𝗎𝖻𝗃 y. mapper g x y @tag 𝒜_backward_transitive_simp
  unfolding Action_Tag_def Premise_def 𝗋Guard_def
  using transformationΛ[unfolded atomize_Ball atomize_all Premise_def 𝗋Guard_def, where Fa=Fa and Fb=Fb and D=D and R=R and mapper=mapper] .

lemma [no_atp, φreason_template default %ToA_derived_one_to_one_functor name Fa.functional_transformation]:
  𝗀𝗎𝖺𝗋𝖽 Functional_Transformation_FunctorΛ Fa Fb T U D R pred_mapper func_mapper
 (p. a  D p x. a  T p 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f p a  U p 𝗐𝗂𝗍𝗁 P p a @tag 𝒯𝒫 )
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (p a. a  D p x  f p a  R p x) 
 x  Fa T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 func_mapper f P x  Fb U 𝗐𝗂𝗍𝗁 pred_mapper f P x @tag 𝒯𝒫
  unfolding 𝗋Guard_def Action_Tag_def
  using apply_Functional_Transformation_FunctorΛ[unfolded Argument_def,
            where func_mapper=func_mapper and pred_mapper=pred_mapper] .



subsection ‹Separation Homomorphism›

lemma Object_Sep_HomoI_subdom[
        φadding_property = false,
        φreason %φTA_varify_out except Object_Sep_HomoI _ ?var,
        φadding_property = true
      ]:
  Object_Sep_HomoI T Da
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Db  Da
 Object_Sep_HomoI T Db
  unfolding Object_Sep_HomoI_def Premise_def subset_iff
  by blast

lemma [φreason_template default %φsimp_derived_Tr_functor+5 name Fb.𝒜simp_sep_homo]:
  𝗀𝗎𝖺𝗋𝖽 Separation_HomoE FaL FaR Fb UL UR Du un
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x  Du
 x  Fb (UL 𝒜 UR) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  FaL UL 𝒜 FaR UR 𝗌𝗎𝖻𝗃 y. y = un x @tag 𝒜simp
  unfolding Separation_HomoE_def Action_Tag_def Bubbling_def 𝗋Guard_def Premise_def
  by (clarsimp simp: Subjection_transformation_rewr Ex_transformation_expn)

(*Object_Sep_HomoI is necessary at least for composition φ-type
Object_Sep_HomoI B ⟷ Separation_HomoI ((⨾) B) ((⨾) B) ((⨾) B) (λx. x)
*)

(*There are two inner element ‹a,b›, we construct an inner transformation from ‹(a ⦂ T) * (b ⦂ T)›
    to ‹(b * a) ⦂ T›
  Note here ‹c = b * a› only if the ‹*› is defined between b and a.
*)

lemma Separation_Homo_functor[φreason_template default %Object_Sep_Homo_functor]:
  Separation_HomoI F F F' T T Ds zz
 Transformation_Functor F' F (T  T) T D R m
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (x y z. m (λ(a, b) c. c = a * b  a ## b  (a, b)  D (zz (x, y))) (zz (x, y)) z
                         z = x * y  x ## y) 
           (x y a b. (a, b)  D (zz (x, y))  a * b  R (zz (x, y)))
 Object_Sep_HomoI T (Set.bind Ds (D o zz))
 Object_Sep_HomoI (F T) Ds
  unfolding Object_Sep_HomoI_def Transformation_Functor_def Separation_HomoI_def Premise_def
            meta_Ball_def meta_case_prod_def split_paired_all
  apply (simp (no_asm_use) add: φProd_expn'[symmetric] del: split_paired_All; clarify)
  subgoal premises prems for x y
  proof -
    have t1: aD (zz (x, y)). a  T  T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  T 𝗌𝗎𝖻𝗃 b. (case a of (a, b)  λc. c = a * b  a ## b  (a, b)  D (zz (x, y))) b
      by (clarsimp, insert prems(3,6), blast)
    from prems(2)[THEN spec[where x=zz (x,y)],
                  THEN spec[where x=λ(a,b) c. c = a * b  a ## b  (a,b)  D (zz (x,y))],
                  THEN mp, OF t1]
         prems(4)[THEN spec[where x=x], THEN spec[where x=y]]
         prems(1,5,6)
    show ?thesis
      by (clarsimp simp add: Transformation_def, blast)
  qed .

lemma [φreason_template name Fc.φProd_ty []]:
  Separation_HomoI Ft Fu Fc T U UNIV (λx. x)
 Separation_HomoE Ft Fu Fc T U UNIV (λx. x)
 Fc (T  U) = Ft T  Fu U
  unfolding Separation_HomoI_def Separation_HomoE_def
  by (rule φType_eqI_Tr ; simp add: split_paired_all)

lemma [φreason_template name FTU.φProd[]]:
  Separation_HomoI FT FU FTU T U Dz f
 Separation_HomoE FT FU FTU T U Du g
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 g (f x) = x  x  Dz  f x  Du
 (x  FT T  FU U) = (f x  FTU (T  U))
  unfolding Separation_HomoE_def Separation_HomoI_def Premise_def Transformation_def
            BI_eq_iff
  by (clarsimp; metis prod.collapse)

(*TODO: a deriver controlling the form of ‹Separation_HomoI_Cond›
Here we give a quick but imperfect deriving without such control
note, also refer to the git branch Separation_HomoΛI_Cond
*)


lemma [φreason_template default %φTA_derived_properties name Ft.Separation_HomoI_Cond]:
  (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 CW  Separation_HomoI Ft Fu F3 T U D z)
 (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 ¬ CW  Functional_Transformation_Functor Ft F3 T (T  ◒[CW] U) D' R' pred' func' )
 Separation_HomoI_Cond Ft Fu F3 CW T U (?ZD[CW] D D' R') (?Z[CW] z (λf. func' f (λ_. True)))
  unfolding Separation_HomoI_Cond_def Separation_HomoI_def Premise_def Action_Tag_def Simplify_def
            LPR_ctrl_def
  by ((cases CW; clarsimp),
       insert apply_Functional_Transformation_Functor
              [unfolded Argument_def Premise_def,
                where Fa=Ft and Fb=F3 and func_mapper=func' and f=(λx. (x, unspec)) and
                      pred_mapper=pred' and P=λ_. True and T=T and U=T  ◒[CW] U and
                      D=D' and R=R'],
       clarsimp simp: φProd_expn', insert transformation_weaken, blast)


lemma [φreason_template default %φTA_derived_properties name Ft.Separation_HomoE_Cond]:
  (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 CR  Separation_HomoE Ft Fu F3 T U Du uz)
 (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 ¬ CR  Functional_Transformation_Functor F3 Ft (T  ◒[CR] U) T Dz R' pred' func' )
 Separation_HomoE_Cond Ft Fu F3 CR T U (?UZD[CR] Du Dz R') (?UZ[CR] uz (λf. func' f (λ_. True)))
  unfolding Separation_HomoE_Cond_def Separation_HomoE_def Premise_def Action_Tag_def Simplify_def
  by ((cases CR; clarsimp),
      insert apply_Functional_Transformation_Functor[unfolded Argument_def Premise_def,
                  where Fa=F3 and Fb=Ft and func_mapper=func' and f=fst and
                        pred_mapper=pred' and P=λ_. True and U=T and T=T  ◒[CR] U and
                        D=Dz and R=R'];
      clarsimp simp: φProd_expn' φProd_expn'',
      metis case_prod_conv transformation_weaken)



subsubsection ‹With Parameterization›

lemma [φreason_template default %φsimp_derived_Tr_functor+5 name Fb.𝒜simp_sep_homo]:
  𝗀𝗎𝖺𝗋𝖽 Separation_HomoΛE FaL FaR Fb UL UR Du un
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x  Du
 x  Fb (λp. UL p 𝒜 UR p) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  FaL UL 𝒜 FaR UR 𝗌𝗎𝖻𝗃 y. y = un x @tag 𝒜simp
  unfolding Separation_HomoΛE_def Action_Tag_def Bubbling_def 𝗋Guard_def Premise_def
  by (clarsimp simp: Subjection_transformation_rewr Ex_transformation_expn)

lemma [φreason_template name Fc.φProd_ty []]:
  Separation_HomoΛI Ft Fu Fc T U UNIV (λx. x)
 Separation_HomoΛE Ft Fu Fc T U UNIV (λx. x)
 Fc (λp. T p  U p) = Ft T  Fu U
  unfolding Separation_HomoΛI_def Separation_HomoΛE_def
  by (rule φType_eqI_Tr ; simp add: split_paired_all)

lemma [φreason_template name FTU.φProd[]]:
  Separation_HomoΛI FT FU FTU T U Dz f
 Separation_HomoΛE FT FU FTU T U Du g
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x  Dz  g (f x) = x  f x  Du
 (x  FT T  FU U) = (f x  FTU (λp. T p  U p))
  unfolding Separation_HomoΛE_def Separation_HomoΛI_def Premise_def
            Transformation_def BI_eq_iff
  by (clarsimp; metis (no_types, lifting) prod.collapse)


lemma [φreason_template default %φTA_derived_properties name Ft.Separation_HomoI_Cond]:
  (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 CW  Separation_HomoΛI Ft Fu F3 T U D z)
 (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 ¬ CW  Functional_Transformation_FunctorΛ Ft F3 T (λp. T p  ◒[CW] U p) D' R' pred' func' )
 (𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φinstantiation] DD : (if LPR_ctrl CW then D else {x. p a. a  D' p (fst x)  (a, unspec)  R' p (fst x)})) @tag 𝒜_template_reason undefined
 (𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φinstantiation] ZZ : (if LPR_ctrl CW then z else func' (λ_ x. (x, unspec)) (λ_ _. True) o fst)) @tag 𝒜_template_reason undefined
 Separation_HomoΛI_Cond Ft Fu F3 CW T U DD ZZ
  unfolding Separation_HomoΛI_Cond_def Separation_HomoΛI_def Premise_def Action_Tag_def Simplify_def
            LPR_ctrl_def
  by (cases CW; clarsimp;
      insert apply_Functional_Transformation_FunctorΛ
                [unfolded Argument_def Premise_def,
                  where Fa=Ft and Fb=F3 and func_mapper=func' and f=λ_ x. (x, unspec) and
                        pred_mapper=pred' and P=λ_ _. True and T=T and U=λp. T p  ◒[CW] U p and
                        D=D' and R=R'];
      clarsimp simp: φProd_expn';
      insert transformation_weaken; blast)

lemma [φreason_template default %φTA_derived_properties name Ft.Separation_HomoE_Cond]:
  (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 CR  Separation_HomoΛE Ft Fu F3 T U Du uz)
 (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 ¬ CR  Functional_Transformation_FunctorΛ F3 Ft (λp. T p  ◒[CR] U p) T D' R' pred' func' )
 (𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φinstantiation] DD : (if LPR_ctrl CR then Du else {x. p. (a,b)  D' p x. a  R' p x})) @tag 𝒜_template_reason undefined
 (𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φinstantiation] UZ : (if LPR_ctrl CR then uz else (λx. (func' (λ_. fst) (λ_ _. True) x, unspec)))) @tag 𝒜_template_reason undefined
 Separation_HomoΛE_Cond Ft Fu F3 CR T U DD UZ
  unfolding Separation_HomoΛE_Cond_def Separation_HomoΛE_def Premise_def Action_Tag_def Simplify_def
  by (cases CR; clarsimp;
      insert apply_Functional_Transformation_FunctorΛ[unfolded Argument_def Premise_def,
                  where Fa=F3 and Fb=Ft and func_mapper=func' and f=λ_. fst and
                        pred_mapper=pred' and P=λ_ _. True and U=T and T=λp. T p  ◒[CR] U p and
                        D=D' and R=R'];
      clarsimp simp: φProd_expn' φProd_expn'';
      metis (no_types, lifting) case_prodD transformation_weaken)



subsection ‹Semimodule›

subsubsection ‹Zero›

lemma [φadding_property = false,
       φreason default %φTA_fallback_lattice,
       φadding_property = true]:
  Closed_Module_Zero F zero
 Module_Zero F zero
  unfolding Closed_Module_Zero_def Module_Zero_def
  by simp

paragraph ‹Equations›

lemma [φreason_template name F.scalar_zero [assertion_simps, simp]]:
  Closed_Module_Zero F zero
 (x  F zero) = 1
  unfolding Closed_Module_Zero_def by blast

lemma [φreason_template name F.scalar_zero' [assertion_simps, simp]]:
  Closed_Module_Zero F zero
 (𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 zero' : zero) @tag 𝒜_template_reason undefined
 NO_MATCH zero zero' @tag 𝒜_template_reason None
 (x  F zero') = 1
  unfolding Closed_Module_Zero_def Simplify_def Action_Tag_def
  by blast

paragraph ‹Identity Elements›

lemma [φreason_template default %derived_identity_element+5]:
  𝗀𝗎𝖺𝗋𝖽 Closed_Module_Zero F zero
 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 zero' = zero
 Identity_ElementsE (F zero') (λ_. True)
  unfolding Identity_ElementsE_def Identity_ElementE_def 𝗋Guard_def
            Transformation_def Premise_def Closed_Module_Zero_def
  by clarsimp

lemma [φreason_template default %derived_identity_element+5]:
  𝗀𝗎𝖺𝗋𝖽 Module_Zero F zero
 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 zero' = zero
 Identity_ElementsI (F zero') (λ_. True) (λ_. True)
  unfolding Identity_ElementsI_def Identity_ElementI_def 𝗋Guard_def
            Transformation_def Premise_def Module_Zero_def
  by clarsimp


paragraph ‹Transformations›

lemma [φreason_template default %ToA_derived_red]:
  Module_Zero F zero
 NO_SIMP (1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y @tag 𝒯𝒫)
 NO_SIMP (x  F zero 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y @tag 𝒯𝒫)
  unfolding Module_Zero_def NO_SIMP_def Action_Tag_def
  using mk_elim_transformation by blast

lemma [φreason_template default %ToA_derived_red ]:
  Module_Zero F zero
 NO_SIMP (R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y  @tag 𝒯𝒫)
 NO_SIMP ((x  F zero) * R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y @tag 𝒯𝒫)
  for R :: 'c::sep_magma_1 BI
  unfolding Module_Zero_def NO_SIMP_def Action_Tag_def
  using transformation_bi_frame
  by fastforce


lemma [φreason_template default %ToA_derived_red]:
  Module_Zero F zero
 NO_SIMP (apfst (λ_. unspec) x    W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y @tag 𝒯𝒫')
 NO_SIMP (x  F zero  W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y @tag 𝒯𝒫')
  for W :: ('c::sep_magma_1, 'x) φ
  unfolding Module_Zero_def NO_SIMP_def Action_Tag_def φProd'_def
  by (cases x; clarsimp simp: φProd_expn'; insert transformation_bi_frame; fastforce)


lemma [φreason_template default %ToA_derived_red]:
  Closed_Module_Zero F zero
 NO_SIMP (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 1 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)
 NO_SIMP (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x  F zero 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)
  unfolding Closed_Module_Zero_def Identity_ElementI_def NO_SIMP_def
  by simp


lemma [φreason_template default %ToA_derived_red]:
  Closed_Module_Zero F zero
 NO_SIMP (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 1 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)
 NO_SIMP (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x  F zero 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)
  for R :: 'c::sep_magma_1 BI
  unfolding Closed_Module_Zero_def Identity_ElementI_def NO_SIMP_def
  by simp


lemma [φreason_template default %ToA_derived_red]:
  Closed_Module_Zero F zero
 NO_SIMP (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x    R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫')
 NO_SIMP (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (any, snd x)  F zero  R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫')
  unfolding Closed_Module_Zero_def Identity_ElementI_def NO_SIMP_def φProd'_def
  by (clarsimp simp add: φProd_expn'' φProd_expn')


subsubsection ‹One›

paragraph ‹Rewrites Eliminating Identity Scalar›

lemma [φreason_template name F.scalar_one_ty [assertion_simps, simp]]:
  Module_OneI F T1 one (λ_. True) (λx. x) PI
 Module_OneE F T1 one (λ_. True) (λx. x) PE
 F one = T1
  unfolding Module_OneI_def Module_OneE_def
  by (rule φType_eqI_Tr; clarsimp simp add: Transformation_def)

lemma [φreason_template name F.scalar_one_ty' [assertion_simps, simp]]:
  Module_OneI F T1 one (λ_. True) (λx. x) PI
 Module_OneE F T1 one (λ_. True) (λx. x) PE
 (𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 one' : one) @tag 𝒜_template_reason undefined
 NO_MATCH one one' @tag 𝒜_template_reason None
 F one' = T1
  unfolding Module_OneI_def Module_OneE_def Simplify_def Action_Tag_def
  by (rule φType_eqI_Tr; clarsimp simp add: Transformation_def)

lemma [φreason_template name F.scalar_one [assertion_simps, simp]]:
  Module_OneI F T1 one DI f PI
 Module_OneE F T1 one DE g PE
 Object_Equiv (F one) eq @tag 𝒜_template_reason undefined
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 DE x  DI (g x)  eq (f (g x)) x
 (x  F one) = (g x  T1)
  unfolding Module_OneI_def Module_OneE_def BI_eq_iff Transformation_def Premise_def
            Object_Equiv_def Action_Tag_def
  by (clarsimp; metis)

lemma [φreason_template name F.scalar_one' [assertion_simps, simp]]:
  Module_OneI F T1 one DI f PI
 Module_OneE F T1 one DE g PE
 (𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 one' : one) @tag 𝒜_template_reason undefined
 NO_MATCH one one' @tag 𝒜_template_reason None
 Object_Equiv (F one) eq @tag 𝒜_template_reason undefined
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 DE x  DI (g x)  eq (f (g x)) x
 (x  F one') = (g x  T1)
  unfolding Module_OneI_def Module_OneE_def BI_eq_iff Transformation_def Premise_def
            Simplify_def Action_Tag_def Object_Equiv_def
  by (clarsimp; metis)


paragraph ‹Protector Preventing Eliminating the just Introduced Scalar Identity›

definition [iff, φsafe_simp]: introduced X  X

subparagraph ‹arith_eval›


lemma [φreason %𝒜_partial_add_normalizing]:
  equation31_cond Cd Cc a b ab c X
 equation31_cond Cd Cc a (introduced b) ab c X
  by simp

lemma [φreason %𝒜_partial_add_normalizing]:
  equation31_cond Cd Cc a b ab c X
 equation31_cond Cd Cc a b ab c (introduced X)
  by simp


lemma [φreason %partial_add_overlaps_norm]:
  partial_add_overlaps a b
 partial_add_overlaps (introduced a) b
  by simp

lemma [φreason %partial_add_overlaps_norm]:
  partial_add_overlaps a b
 partial_add_overlaps a (introduced b)
  by simp


paragraph ‹ToA Eliminating Identity Scalar›

subparagraph ‹Implementation›

lemma [φreason_template default %ToA_derived_red]:
  𝗀𝗎𝖺𝗋𝖽 Module_OneE F T1 one DE g PE
 𝗀𝗎𝖺𝗋𝖽 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[𝗌𝖺𝖿𝖾] one'' : one'
 𝗀𝗎𝖺𝗋𝖽 is_id_element one (NO_SIMP one'')
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 DE x
 NO_SIMP (g x  T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)
 x  F one' 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P  PE x @tag 𝒯𝒫
      <except-pattern> x  F (introduced one') 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 YYY 𝗐𝗂𝗍𝗁 PPP @tag 𝒯𝒫
  unfolding Module_OneI_def Module_OneE_def NO_SIMP_def 𝗋Guard_def Premise_def
            Transformation_def Except_Pattern_def is_id_element_def Simplify_def Action_Tag_def
  by (clarsimp; metis)

lemma [φreason_template default %ToA_derived_red]:
  𝗀𝗎𝖺𝗋𝖽 Module_OneE F T1 one DE g PE
 𝗀𝗎𝖺𝗋𝖽 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[𝗌𝖺𝖿𝖾] one'' : one'
 𝗀𝗎𝖺𝗋𝖽 is_id_element one (NO_SIMP one'')
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 DE x
 NO_SIMP (R * (g x  T1) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)
 R * (x  F one') 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P  PE x @tag 𝒯𝒫
      <except-pattern> RRR * (x  F (introduced one')) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 YYY 𝗐𝗂𝗍𝗁 PPP @tag 𝒯𝒫
  unfolding Module_OneE_def NO_SIMP_def 𝗋Guard_def Premise_def Transformation_def
            Except_Pattern_def is_id_element_def Simplify_def Action_Tag_def
  by (clarsimp; metis)
  ― ‹the rule is invoked only once for each φ-type in the source, so no problem to invoke the
      simple tactic for each time.›

lemma [φreason_template default %ToA_derived_red]:
  𝗀𝗎𝖺𝗋𝖽 Module_OneE F T1 one D g PE
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D (fst x)
 NO_SIMP (apfst g x  T1  W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫')
 x  F one  W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P  PE (fst x) @tag 𝒯𝒫'
  unfolding Module_OneE_def NO_SIMP_def 𝗋Guard_def Premise_def Transformation_def Action_Tag_def φProd'_def
  by (cases x; clarsimp simp add: φProd_expn'; metis)

lemma [φreason_template default %ToA_derived_red]:
  𝗀𝗎𝖺𝗋𝖽 Module_OneE F T1 one D g PE
 (𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 one' : one) @tag 𝒜_template_reason undefined
 NO_MATCH one one' @tag 𝒜_template_reason None
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D (fst x)
 NO_SIMP (apfst g x  T1  W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫')
 x  F one'  W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P  PE (fst x) @tag 𝒯𝒫'
  unfolding Module_OneE_def NO_SIMP_def 𝗋Guard_def Premise_def Simplify_def Action_Tag_def Action_Tag_def
            Transformation_def Except_Pattern_def φProd'_def
  by (clarsimp simp add: φProd_expn'; metis)

lemma [φreason_template default %derived_SE_red_scalar_one]:
  𝗀𝗎𝖺𝗋𝖽 Module_OneE F T1 one D g PE
 𝗀𝗎𝖺𝗋𝖽 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[𝗌𝖺𝖿𝖾] one'' : one'
 𝗀𝗎𝖺𝗋𝖽 is_id_element one (NO_SIMP one'')
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D (fst x)
 NO_SIMP (apfst g x  T1  W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫')
 x  F one'  W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P  PE (fst x) @tag 𝒯𝒫'
      <except-pattern> x  F (introduced one')  WWW 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 YYY 𝗐𝗂𝗍𝗁 PPP @tag 𝒯𝒫'
  unfolding Module_OneE_def NO_SIMP_def 𝗋Guard_def Premise_def Transformation_def
            Except_Pattern_def Simplify_def is_id_element_def Action_Tag_def φProd'_def
  by (clarsimp simp add: φProd_expn'; metis)



lemma [φreason_template default %ToA_derived_red]:
  𝗀𝗎𝖺𝗋𝖽 Module_OneI F T1 one D f PI
 𝗀𝗎𝖺𝗋𝖽 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[𝗌𝖺𝖿𝖾] one'' : one'
 𝗀𝗎𝖺𝗋𝖽 is_id_element one (NO_SIMP one'')
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
 NO_SIMP (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x  T1 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)
 X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x  F one' 𝗐𝗂𝗍𝗁 P  PI x @tag 𝒯𝒫
      <with-pattern> X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 var  F one' 𝗐𝗂𝗍𝗁 PP @tag 𝒯𝒫
      <except-pattern> X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x''  F (introduced one') 𝗐𝗂𝗍𝗁 PP @tag 𝒯𝒫
  unfolding Module_OneI_def NO_SIMP_def 𝗋Guard_def Premise_def Except_Pattern_def
            Transformation_def With_Pattern_def Simplify_def is_id_element_def Action_Tag_def
  by (simp; metis)

lemma [φreason_template default %ToA_derived_red]:
  𝗀𝗎𝖺𝗋𝖽 Module_OneI F T1 one D f PI
 𝗀𝗎𝖺𝗋𝖽 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[𝗌𝖺𝖿𝖾] one'' : one'
 𝗀𝗎𝖺𝗋𝖽 is_id_element one (NO_SIMP one'')
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
 NO_SIMP (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x  T1 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)
 X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x  F one' 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 R 𝗐𝗂𝗍𝗁 P  PI x @tag 𝒯𝒫
      <with-pattern> X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 var  F one' 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 R 𝗐𝗂𝗍𝗁 PP @tag 𝒯𝒫
      <except-pattern> X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x''  F (introduced one') 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 R 𝗐𝗂𝗍𝗁 PP @tag 𝒯𝒫
  unfolding Module_OneI_def NO_SIMP_def 𝗋Guard_def Premise_def Transformation_def
            With_Pattern_def Except_Pattern_def is_id_element_def Simplify_def Action_Tag_def
  by (clarsimp; metis)

lemma [φreason_template default %ToA_derived_red]:
  𝗀𝗎𝖺𝗋𝖽 Module_OneI F T1 one D f PI
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D (fst x)
 NO_MATCH (id one'') one @tag 𝒜_template_reason undefined
 NO_SIMP (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x  T1  R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫')
 X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 apfst f x  F one  R 𝗐𝗂𝗍𝗁 P  PI (fst x) @tag 𝒯𝒫'
      <with-pattern> X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 var  F one  RR 𝗐𝗂𝗍𝗁 PP @tag 𝒯𝒫'
  unfolding Module_OneI_def NO_SIMP_def 𝗋Guard_def Premise_def Transformation_def
            With_Pattern_def Action_Tag_def φProd'_def
  by (cases x; clarsimp simp add: φProd_expn'; metis)

lemma [φreason_template default %ToA_derived_red]:
  𝗀𝗎𝖺𝗋𝖽 Module_OneI F T1 one D f PI
 (𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 one' : one) @tag 𝒜_template_reason undefined
 NO_MATCH one one' @tag 𝒜_template_reason None
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D (fst x)
 NO_SIMP (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x  T1  R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫')
 X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 apfst f x  F one'  R 𝗐𝗂𝗍𝗁 P  PI (fst x) @tag 𝒯𝒫'
      <with-pattern> X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 var  F one'  RR 𝗐𝗂𝗍𝗁 PP @tag 𝒯𝒫'
  unfolding Module_OneI_def NO_SIMP_def 𝗋Guard_def Premise_def Simplify_def Action_Tag_def
            Transformation_def With_Pattern_def φProd'_def
  by (cases x; clarsimp simp add: φProd_expn'; metis)

lemma [φreason_template default %derived_SE_red_scalar_one]:
  𝗀𝗎𝖺𝗋𝖽 Module_OneI F T1 one D f PI
 𝗀𝗎𝖺𝗋𝖽 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[𝗌𝖺𝖿𝖾] one'' : one'
 𝗀𝗎𝖺𝗋𝖽 is_id_element one (NO_SIMP one'')
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D (fst x)
 NO_SIMP (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x  T1  R 𝗐𝗂𝗍𝗁 P) @tag 𝒯𝒫'
 X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 apfst f x  F one'  R 𝗐𝗂𝗍𝗁 P  PI (fst x) @tag 𝒯𝒫'
      <with-pattern> X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 var  F one'  RR 𝗐𝗂𝗍𝗁 PP @tag 𝒯𝒫'
      <except-pattern> X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x''  F (introduced one')  RR 𝗐𝗂𝗍𝗁 PP @tag 𝒯𝒫'
  unfolding Module_OneI_def NO_SIMP_def 𝗋Guard_def Premise_def Transformation_def φProd'_def
            With_Pattern_def Except_Pattern_def Simplify_def is_id_element_def Action_Tag_def
  by (cases x; clarsimp simp add: φProd_expn'; metis)

(*TODO: provide the version for ToA mapper*)


paragraph ‹Reasoning when having SDistr›

text ‹The difficulty of reasoning φ-type transformations lies in the two directions that 
  the transformations can follow, hierarchically swapping an inner φ-type out F (G T) ⟶ G (F T)›
  and horizontally over *› including splitting and merging.

  As an example example, the reasoning of transformation
  x ⦂ F a T * others ⟶ y ⦂ F b U› with a ≤ b› can reduce to 2 subgoals, T ⟶ F (b/a) U› which looks
  for the missed portion from the inner hierarchy of T›, or others ⟶ F (b-a) U› which looks
  horizontally from the φ-types beside, or even any mixture of the two subgoals -- some portion from inner
  and some portion beside.

  To reduce the search space, we first normalize an assertion by swapping commutative φ-type operators
  to move identical operators into the same level, so that the later reasoning only needs to consider
  horizontal splitting and merging. To do so, we assign a weight to each φ-type such that two φ-types
  are of an identical weight iff they are identical.
  φ-Types of a higher weight will sink towards the leaves during the normalization,
  so the normalization ensures weight(F) ≤ weight(G)› for any normalized term F (G T)› iff F›
  is commutative over G› and F,G› have a weight.
  The weight can be annotated by users, to have a better control of the normalization,
  or simplify by lexical order if not significant.

  When identical φ-types are on the same level, the reasoning of the transformations
  x ⦂ F a T ⟶ y ⦂ U› or y ⦂ U ⟶ x ⦂ F a T› where a semimodule φ-type is given in one side but
  missed in the opposite side, can decide whether to embed the opposite φ-type
  U› into a semimodule F 1 U› of identity scalar, by checking whether the weight of U› is greater than
  the weight of F a T›, which implies no swappable semimodule F› that can move here can be seen in U›.

  If we denote F > G ≜ weight(F) > weight(G) ∧ commutative(F,G)›, the normalization ensures in
  a given syntactic tree of φ-type operators, any path from the root to a leaf φ-type is non-descending,
  i.e., ¬ (F > G)› for any adjacent F, G›, i.e., F› is not heavier than G› if commutative(F,G)›.
  A problem is whether all syntactic tree of φ-type operators can be uniquely normalized.
  *: The check of F > G› is carried by LP reasoner Require_Weight_Norm› in the code.

  For the sake of unique normalization, we require all commutativity between the φ-type operators is transitive.
  We designate commutative(F,G)› to mean F› can be swapped into G›, ∃f. x ⦂ F (G T) ⟶ f(x) ⦂ G (F T)›,
  but not necessarily reversely.
  The transitivity means commutative(F1,F2) ∧ commutative(F2,F3) ⟶ commutative(F1,F3)›.
  If we draw a directed edge from F› to G› to mean weight(F) < weight(G)› and F› can be swapped with G›
  by any steps of swapping adjacent operators in the sequence (another name of the path).
  The transitivity ensures any given sequence generates a disjoint union of several fully connected
  directed acyclic graph.
  Therefore, for any given sequence, we only need to swap any occurrences of F, G› where F > G› (a bubbling sort),
  and any order of swapping results in the unique normalized form, which is the topological sorting
  of the generated graph with connected components in the order of their occurrences in the sequence.
  Therefore, a path can be uniquely normalized.

  Another issue is many paths exist in the tree. We can normalize the paths one by one in any order.
  An operator F› can be of multi-arity, so multiple children. Assume one path of the operand Gi is
  normalized, when the normalization of another operand Gj swaps Gj out of F›, Gj is inserted
  into the normalized path of Gi, changing it from Root … F Gi … Leaf› to Root … Gj F Gi … Leaf›.
  The sub-sequence Gi … Leaf› is unchanged but the property of Root … Gj F› is temporarily broken.
  However, with the normalization of the path Gj, Root … Gj F› will be normalized, and the concatenation
  of the normalized Root … Gj F› with Gi … Leaf› also yields a normalized path, because ¬ (Gi > F)›.

  Besides, not all multi-arity operator pair (F,G)› has partial commutativity (in sense of fixing
  all of its operands except one, F (fixed, G(T)) ⟶ G (F (fixed, T))›, so reducing the notion of
  multi-arity commutativity to the normal commutativity of single-arity type operators),
  but total commutativity where all operands are of the same φ-type and swapped together,
  e.g., F (G(T), G(U)) ⟶ G (F (T, U))› and F=(∗), G=(() k)› is an instance.
  It brings no problem to the normalization, because it is swapping F› and G› simultaneously in
  the paths of all its operands, and this swapping is valid in either of the paths in our bubbling sort
  algorithm.

  At last, not all operators need normalization. Operators like ∗, +, ∧, Σ› are already handled well
  by the reasoner, so they can occur anywhere in the tree and there is no need to move them onto certain same level.
  We do not assign a weight to them so they do not have any weight relation with others.
  It optimizes the normalization performance.
›

subparagraph ‹Preliminary›

consts restore_from_semimodule :: bool  ('s  ('e, 'd) φ)  action 

declare [[ φreason_default_pattern
     _  _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _  ?U 𝗐𝗂𝗍𝗁 _ @tag restore_from_semimodule True ?F 
     _  _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _  ?U 𝗐𝗂𝗍𝗁 _ @tag restore_from_semimodule True ?F     (100)
 and _  ?T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _  _ 𝗐𝗂𝗍𝗁 _ @tag restore_from_semimodule False ?F 
     _  ?T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _  _ 𝗐𝗂𝗍𝗁 _ @tag restore_from_semimodule False ?F    (100)
]]

φreasoner_group restore_from_semimodule = (1000, [1000,1001]) for _ @tag restore_from_semimodule _ _
  ‹The reasoning later lifts a φ-type in to a semimodule with scalar one. The lifted semimodule
   not always succeeds, and may return with no change. If so, the reasoning process here, restore the
   lifted semimodule back to the original φ-type, by unwrapping the scalar one. ›

lemma [φreason %restore_from_semimodule+1]:
  𝗀𝗎𝖺𝗋𝖽 Module_OneI F T1 one D f PI
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
 x  T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x  F (introduced one) @tag restore_from_semimodule True F
  unfolding Module_OneI_def Action_Tag_def Transformation_def Premise_def 𝗋Guard_def
  by simp

lemma [φreason %restore_from_semimodule+1]:
  𝗀𝗎𝖺𝗋𝖽 Module_OneE F T1 one D f PE
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
 x  F (introduced one) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x  T1 @tag restore_from_semimodule False F
  unfolding Module_OneE_def Action_Tag_def Transformation_def Premise_def 𝗋Guard_def
  by simp

lemma [φreason %restore_from_semimodule for _ 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 _ @tag restore_from_semimodule _ _]:
  X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X @tag restore_from_semimodule Any F
  unfolding Action_Tag_def
  by simp


subparagraph ‹Main›

lemma [φreason_template default %derived_SE_inj_to_module name F.wrap_module_src]:
  𝗀𝗎𝖺𝗋𝖽 partial_add_overlaps one b
 𝗀𝗎𝖺𝗋𝖽 Not_Require_SA_Norm (F one) True
 𝗀𝗎𝖺𝗋𝖽 Type_Variant_of_the_Same_Scalar_Mul0 F F'
 𝗀𝗎𝖺𝗋𝖽 Module_OneI F T1 one D f PI
 NO_SIMP (apfst f x  F (introduced one)  W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  F' b  R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫')
 NO_SIMP (snd x  W' 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 snd x  W  @tag restore_from_semimodule True F)
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D (fst x)
 x  T1  W' 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  F' b  R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'
      <except-pattern> xx  F aa  W' 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  F' b  R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'
  unfolding Module_OneI_def Transformation_def Premise_def 𝗋Guard_def
            Action_Tag_def NO_SIMP_def Except_Pattern_def φProd'_def
  by (clarsimp; metis)


lemma [φreason_template default %derived_SE_inj_to_module+1 name F.wrap_module_tgt]:
  𝗀𝗎𝖺𝗋𝖽 partial_add_overlaps a one
 𝗀𝗎𝖺𝗋𝖽 Not_Require_SA_Norm (F one) False
 𝗀𝗎𝖺𝗋𝖽 Type_Variant_of_the_Same_Scalar_Mul0 F' F
 𝗀𝗎𝖺𝗋𝖽 Module_OneE F T1 one D f PE
 NO_SIMP (y  F' a  W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x  F (introduced one)  R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫')
 NO_SIMP (snd x  R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 r  R' @tag restore_from_semimodule False F)
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D (fst x)
 y  F' a  W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (f (fst x), r)  T1  R' 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'
      <except-pattern> y  F' a  W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 xx  F bb  R' 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'
  unfolding Module_OneE_def Transformation_def Premise_def 𝗋Guard_def
            Action_Tag_def NO_SIMP_def Except_Pattern_def φProd'_def
  by (clarsimp; blast)

lemma ToA_mapper_MOne_src
  [no_atp, φreason_template default %φmapToA_derived_module_wrapper name F.mapper_wrap_module_src]:
  𝗀𝗎𝖺𝗋𝖽 partial_add_overlaps a one
 𝗀𝗎𝖺𝗋𝖽 partial_add_overlaps b one'
 𝗀𝗎𝖺𝗋𝖽 Not_Require_SA_Norm (F one) True
 𝗀𝗎𝖺𝗋𝖽 Not_Require_SA_Norm (F one') True
 𝗀𝗎𝖺𝗋𝖽 Type_Variant_of_the_Same_Scalar_Mul0 F' F
 𝗀𝗎𝖺𝗋𝖽 Type_Variant_of_the_Same_Scalar_Mul0 F' G
 𝗀𝗎𝖺𝗋𝖽 Type_Variant_of_the_Same_Scalar_Mul0 F' G'

 𝗀𝗎𝖺𝗋𝖽 Module_OneI F T1 one DI I1 PI
 𝗀𝗎𝖺𝗋𝖽 Module_OneE G U1 one' DE E1 PE

 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (xfst ` D. DI x  DE (f (I1 x)))

 𝗆𝖺𝗉 g f r : F' a  R  G' b  R
    𝗈𝗏𝖾𝗋 f f w : F (introduced one)  W  G (introduced one')  W
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s 𝗂𝗇 apfst I1 ` D

 𝗆𝖺𝗉 g f r : F' a  R  G' b  R
    𝗈𝗏𝖾𝗋 (E1 o f o I1) f w : T1  W  U1  W
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h o apfst I1 𝗌𝖾𝗍𝗍𝖾𝗋 apfst E1 o s 𝗂𝗇 D
  unfolding 𝗋Guard_def φProd'_def
  apply (simp add: φProd_expn'' φProd_expn' φSome_φProd[symmetric])
   premises _ and _ and _ and _ and _ and _ and _ and S1I[] and S1E[] and _ and Tr[] 
    apply_rule apply_Module_OneI[OF S1I]
    apply_rule ToA_Mapper_onward[OF Tr, where x=apfst I1 x]
   apply(rule conjunctionI, rule)
   premises _ and _ and _ and _ and _ and _ and _ and S1I[] and S1E[] and _ and Tr[]
    apply_rule ToA_Mapper_backward[OF Tr] certified by (instantiate x; auto_sledgehammer) 
    apply_rule apply_Module_OneE[OF S1E]
      certified by (insert ToA_Mapper_f_expn[OF Tr], auto_sledgehammer) ;;
  
   by (rule conjunctionI, rule, drule ToA_Mapper_f_expn_rev, clarsimp)
  

lemma ToA_mapper_MOne_tgt
  [no_atp, φreason_template default %φmapToA_derived_module_wrapper+1 name F.mapper_wrap_module_tgt]:
  𝗀𝗎𝖺𝗋𝖽 partial_add_overlaps a one
 𝗀𝗎𝖺𝗋𝖽 partial_add_overlaps b one'
 𝗀𝗎𝖺𝗋𝖽 Not_Require_SA_Norm (F one) False
 𝗀𝗎𝖺𝗋𝖽 Not_Require_SA_Norm (G one') False
 𝗀𝗎𝖺𝗋𝖽 Type_Variant_of_the_Same_Scalar_Mul0 F' F
 𝗀𝗎𝖺𝗋𝖽 Type_Variant_of_the_Same_Scalar_Mul0 F' G
 𝗀𝗎𝖺𝗋𝖽 Type_Variant_of_the_Same_Scalar_Mul0 F' G'

 𝗀𝗎𝖺𝗋𝖽 Module_OneI G U1 one' DI E1 PI
 𝗀𝗎𝖺𝗋𝖽 Module_OneE F T1 one DE I1 PE

 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (xD. DE (fst (h x))  DI (g (I1 (fst (h x)))))

 𝗆𝖺𝗉 (E1 o g o I1) f r : F (introduced one)  R  G (introduced one')  R
    𝗈𝗏𝖾𝗋 f f w : F' a  W  G' b  W
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s 𝗂𝗇 D

 𝗆𝖺𝗉 g f r : T1  R  U1  R
    𝗈𝗏𝖾𝗋 f f w : F' a  W  G' b  W
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 apfst I1 o h 𝗌𝖾𝗍𝗍𝖾𝗋 s o apfst E1 𝗂𝗇 D
  for F :: 'a::plus  'b  'c::sep_magma_1 BI
  and T1 :: 'b2  'c BI
  unfolding 𝗋Guard_def φProd'_def
  apply (simp add: φProd_expn'' φProd_expn' φSome_φProd[symmetric])
   premises _ and _ and _ and _ and _ and _ and _ and S1I[] and S1E[] and _ and Tr[]
    apply_rule ToA_Mapper_onward[OF Tr, where x=x]
    apply_rule apply_Module_OneE[OF S1E]
   apply(rule conjunctionI, rule)
   premises _ and _ and _ and _ and _ and _ and _ and S1I[] and S1E[] and _ and Tr[]
    apply_rule apply_Module_OneI[OF S1I]
    certified by auto_sledgehammer 
    apply_rule ToA_Mapper_backward[OF Tr, where x=apfst E1 x]
    certified by (insert ToA_Mapper_f_expn[OF Tr] useful; auto simp add: fun_eq_iff map_prod_def image_iff;
                  smt (verit, best) Pair_inject apfst_convE case_prod_conv)  ;;
   by(rule conjunctionI, rule, drule ToA_Mapper_f_expn_rev, clarsimp simp: Premise_def prod.map_beta)



subsubsection ‹Associativity›

lemma scalar_assoc_template[φreason_template name Fc.scalar_assoc [assertion_simps]]:
  Module_AssocI Fs Ft Fc T Ds Dt (λ_ _ _. True) smul (λ_ _ x. x)
 Module_AssocE Fs Ft Fc T Ds Dt (λ_ _ _. True) smul (λ_ _ x. x)
 Ds s  Dt t
 Fs s (Ft t T) = Fc (smul s t) T
  unfolding Module_AssocE_def Module_AssocI_def
  by (rule φType_eqI_Tr; simp)


lemma [φreason_template name Fc.scalar_functor [no_atp]]:
  Module_AssocI Fs' Ft' Fc' U Ds' Dt' Dx' smul' f'
 Module_AssocE Fs Ft Fc T Ds Dt Dx smul f
 Functional_Transformation_Functor (Fs s) (Fs' s') (Ft t T) (Ft' t' U) D R pm fm
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds s  Dt t  Ds' s'  Dt' t'  Dx s t x 
           Dx' s' t' (fm g P (f s t x))  ( a  D (f s t x). g a  R (f s t x))
 (a  D (f s t x). a  Ft t T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 g a  Ft' t' U 𝗐𝗂𝗍𝗁 P a @tag 𝒯𝒫 )
 x  Fc (smul s t) T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f' s' t' (fm g P (f s t x))  Fc' (smul' s' t') U 𝗐𝗂𝗍𝗁 pm g P (f s t x) @tag 𝒯𝒫
  unfolding Module_AssocI_def Module_AssocE_def
            Transformation_def Premise_def Functional_Transformation_Functor_def
            meta_Ball_def Action_Tag_def
  by clarsimp metis
 
lemma template_scalar_partial_functor[φreason_template name Fc.scalar_partial_functor [no_atp]]:
  Module_AssocI Fs' Ft' Fc' U Ds' Dt' Dx' smul' f'
 Module_AssocE Fs Ft Fc T Ds Dt Dx smul f
 Separation_HomoI_Cond (Fs s) FW FsW CW (Ft t T) W Dz z
 Separation_HomoE_Cond (Fs' s') FR FsR CR (Ft' t' U) R Du uz
 Functional_Transformation_Functor FsW FsR (Ft t T  ◒[CW] W) (Ft' t' U  ◒[CR] R) D Rng pm fm
 (a  D (z (apfst (f s t) x)).
           a  Ft t T  W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 g a  Ft' t' U  R 𝗐𝗂𝗍𝗁 P a @tag 𝒯𝒫' )
 SE_Has_or_Not CW W FW FW
 SE_Has_or_Not CR R FR FR
 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[𝗌𝖺𝖿𝖾] (prem, ff, PP) : (
      Dx' s' t' (fst (uz (fm g P (z (apfst (f s t) x)))))  (apfst (f s t) x)  Dz 
        (a  D (z (apfst (f s t) x)). g a  Rng (z (apfst (f s t) x))) 
        (fm g P (z (apfst (f s t) x)))  Du,
      apfst (f' s' t') (uz (fm g P (z (apfst (f s t) x)))),
      pm g P (z (apfst (f s t) x)))
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds s  Dt t  Ds' s'  Dt' t'  Dx s t (fst x)  prem
 x  Fc (smul s t) T  FW 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ff  Fc' (smul' s' t') U  FR 𝗐𝗂𝗍𝗁 PP @tag 𝒯𝒫'
  unfolding Action_Tag_def φProd'_def SE_Has_or_Not_alt_def
   premises SAI[] and SAE[] and SHI[] and SHE[] and FTF[] and Tr[] and [simp] and [simp]
    apply_rule transformation_right_frame_ty[OF apply_Semimodule_SAssocE[OF SAE]]
    apply_rule apply_Separation_HomoI_Cond[OF SHI, simplified]
    apply_rule apply_Functional_Transformation_Functor[OF FTF, where P=P, simplified]
     Tr 
    apply_rule apply_Separation_HomoE_Cond[OF SHE, simplified]
    apply_rule transformation_right_frame_ty[OF apply_Semimodule_SAssocI[OF SAI]]
   .


lemma [φreason_template default %ToA_derived_red]:
  𝗀𝗎𝖺𝗋𝖽 Require_Assoc_Norm (Fs s (Ft t T)) True
 Module_AssocI Fs Ft Fc T Ds Dt Dx smul f
 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ds s  Dt t  Dx s t x
 NO_SIMP (f s t x  Fc (smul s t) T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)
 NO_SIMP (x  Fs s (Ft t T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)
  unfolding NO_SIMP_def Module_AssocI_def 𝗋Guard_def Premise_def Action_Tag_def
  using mk_elim_transformation by blast

lemma [φreason_template default %ToA_derived_red]:
  𝗀𝗎𝖺𝗋𝖽 Require_Assoc_Norm (Fs s (Ft t T)) True
 Module_AssocI Fs Ft Fc T Ds Dt Dx smul f
 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ds s  Dt t  Dx s t x
 NO_SIMP (R * (f s t x  Fc (smul s t) T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)
 NO_SIMP (R * (x  Fs s (Ft t T)) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)
  unfolding Module_AssocI_def Premise_def NO_SIMP_def 𝗋Guard_def Action_Tag_def
  using transformation_left_frame mk_elim_transformation by blast

lemma [φreason_template default %ToA_derived_red]:
  𝗀𝗎𝖺𝗋𝖽 Require_Assoc_Norm (Fs s (Ft t T)) False
 Module_AssocE Fs Ft Fc T Ds Dt Dx smul f
 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ds s  Dt t  Dx s t x
 NO_SIMP (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x  Fc (smul s t) T 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)
 NO_SIMP (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f s t x  Fs s (Ft t T) 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)
  unfolding Module_AssocE_def Premise_def NO_SIMP_def 𝗋Guard_def Action_Tag_def
  using mk_intro_transformation by blast

lemma [φreason_template default %ToA_derived_red]:
  𝗀𝗎𝖺𝗋𝖽 Require_Assoc_Norm (Fs s (Ft t T)) False
 Module_AssocE Fs Ft Fc T Ds Dt Dx smul f
 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ds s  Dt t  Dx s t x
 NO_SIMP (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x  Fc (smul s t) T 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)
 NO_SIMP (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f s t x  Fs s (Ft t T) 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫)
  unfolding Module_AssocE_def Premise_def NO_SIMP_def 𝗋Guard_def Action_Tag_def REMAINS_def
  using transformation_right_frame mk_intro_transformation by blast

lemma [φreason_template %To_ToA_derived_SAssoc]:
  Module_AssocE Fs Ft Fc T Ds Dt Dx smul f
 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ds s  Dt t  Dx s t x
 x  Fc (smul s t) T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  Fs s (Ft t T) 𝗌𝗎𝖻𝗃 y. y = f s t x @tag to (𝗌𝗉𝗅𝗂𝗍-𝖺𝗌𝗌𝗈𝖼 s t)
  unfolding Module_AssocE_def Premise_def 𝗋Guard_def Action_Tag_def
  by simp
  

paragraph ‹ToA-based Simplification›

lemma [φreason_template [φtransformation_based_backward_simp default %To_ToA_derived_SAssoc no trigger]]:
  Module_AssocE Fs Ft Fc T Ds Dt Dx smul f
 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ds s  Dt t  Dx s t x
 x  Fc (smul s t) T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  Fs s (Ft t T) 𝗌𝗎𝖻𝗃 y. y = f s t x @tag 𝒜backward_simp
  unfolding Module_AssocE_def Premise_def 𝗋Guard_def Action_Tag_def
  by simp

lemma [φreason_template [φtransformation_based_simp default %To_ToA_derived_SAssoc no trigger]]:
  Module_AssocI Fs Ft Fc T Ds Dt Dx smul f
 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ds s  Dt t  Dx s t x
 x  Fs s (Ft t T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  Fc (smul s t) T 𝗌𝗎𝖻𝗃 y. y = f s t x @tag 𝒜simp
  unfolding Module_AssocI_def Premise_def 𝗋Guard_def Action_Tag_def
  by simp


subsubsection ‹Scalar Distributivity›

lemma [φreason_template name F.unfold_sdistr[]]:
  Module_Distr_HomoS F Ds Du uz
 Module_Distr_HomoZ F Ds Dz zi
 Ds s  Ds t  s ##+ t  Du s t x  Dz s t (uz s t x) 
    zi s t (uz s t x) = x
 (x  F (s + t)) = (uz s t x  F s  F t)
  unfolding Module_Distr_HomoZ_def Module_Distr_HomoS_def
  by (rule assertion_eq_intro; clarsimp simp del: split_paired_All; metis)

paragraph ‹Checking of Non-SDistr›

lemma [φreason_template 0]:
  Semimodule_No_SDistr F
 Module_Distr_HomoS F Ds Du uz
 ERROR TEXT(F ‹is declared as non-scalar-associative but a property is given›
               (Module_Distr_HomoS F Ds Du uz)) @tag 𝒜_template_reason undefined
 True
  ..

lemma [φreason_template 0]:
  Semimodule_No_SDistr F
 Module_Distr_HomoZ F Ds Du uz
 ERROR TEXT(F ‹is declared as non-scalar-associative but a property is given›
               (Module_Distr_HomoZ F Ds Du uz)) @tag 𝒜_template_reason undefined
 True
  ..


paragraph ‹Zip›

lemma SDirst_in_comm_scalar_implies_revZ
      [φadding_property = false,
       φreason default %φTA_fallback_lattice,
       φadding_property = true]:
  Module_Distr_HomoZ F Ds Dx z
 Module_Distr_HomoZ_rev F Ds Dx z Dx z
  for F :: ('s::partial_ab_semigroup_add  ('c::sep_magma,'a) φ)
  unfolding Module_Distr_HomoZ_rev_def Module_Distr_HomoZ_def
  by (simp add: dom_of_add_commute partial_add_commute)

lemma SDirst_in_comm_sep_implies_revZ
      [φadding_property = false,
       φreason default %φTA_fallback_lattice-1,
       φadding_property = true]:
  Module_Distr_HomoZ F Ds Dx z
 Module_Distr_HomoZ_rev F Ds Dx z (λs t. Dx t s o prod.swap) (λs t. z t s o prod.swap)
  for F :: ('s::partial_add_magma  ('c::sep_ab_semigroup,'a) φ)
  unfolding Module_Distr_HomoZ_rev_def Module_Distr_HomoZ_def
  by (simp add: φProd_expn'; metis mult.commute)


paragraph ‹Unzip›

lemma SDirst_in_comm_scalar_implies_revU
      [φadding_property = false,
       φreason default %φTA_fallback_lattice,
       φadding_property = true]:
  Module_Distr_HomoS F Ds Dx uz
 Module_Distr_HomoS_rev F Dx uz Ds Dx uz
  for F :: ('s::partial_ab_semigroup_add  ('c::sep_magma,'a) φ)
  unfolding Module_Distr_HomoS_rev_def Module_Distr_HomoS_def
  by (simp add: dom_of_add_commute partial_add_commute)

lemma SDirst_in_comm_sep_implies_revU
      [φadding_property = false,
       φreason default %φTA_fallback_lattice-1,
       φadding_property = true]:
  Module_Distr_HomoS F Ds Dx z
 Module_Distr_HomoS_rev F Dx uz Ds (λs t. Dx t s) (λs t. prod.swap o z t s)
  for F :: ('s::partial_add_magma  ('c::sep_ab_semigroup,'a) φ)
  unfolding Module_Distr_HomoS_rev_def Module_Distr_HomoS_def
  by (clarsimp simp add: φProd_expn'' mult.commute)

lemma [φreason_template %To_ToA_derived_SDistri]:
  Module_Distr_HomoS F Ds Dx uz
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds s  Ds t  s ##+ t  Dx s t x
 x  F (s + t) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  F s  F t 𝗌𝗎𝖻𝗃 y. y = uz s t x @tag to (𝗌𝗉𝗅𝗂𝗍-𝗌𝖼𝖺𝗅𝖺𝗋 s t)
  unfolding Module_Distr_HomoS_def Premise_def Action_Tag_def
  by simp


subsection ‹Separation Extraction›

subsubsection ‹Transformation Functors›



(* This crazy rule is for the boundary cases when we reason the last element and when the algebra doesn't
   have an identity element so that we cannot reduce it to the usual case by adding an identity element at the tail.

The idea is to lift the non-unital algebra by adding an identity element. We use const‹●› for it.
But it is not the end. Because substantially its reasoning has no identity element, we have to use
term‹◒[Cw] W› with a boolean flag ‹Cw› to rudimentarily check if the remainder is needed or not.

If u cannot use the identity element, the reasoning itself changes,
like sometimes you have to apply Sep_Homo zipper while in another case you shouldn't use that.
There is no trivial degeneration of Sep_Homo. There is no an identity element representing nothing.
So if u are going to zip something, u really need to zip some two concrete things,
instead of using the identity element to represent the degenerated situation where you actually zipped nothing.
It forces us to really consider the cases of having remainders or not in the reasoning.

The rule below is complicated, but is branch-less in reasoning. All branch expressions are in object level,
free from explosion of expression, and can be simplified easily because the boolean flags are
assigned by constants after the reasoning.

*)

 
paragraph ‹Transformation Functor›

lemma [φreason_template default %derived_SE_functor name F1.separation_extraction]:
  𝗀𝗎𝖺𝗋𝖽 Functional_Transformation_Functor F14 F23 (T  ◒[Cw] W) (U  ◒[Cr] R) Dom Rng pred_mapper func_mapper
 𝗀𝗎𝖺𝗋𝖽 Separation_HomoI_Cond F1 F4 F14 Cw T W Dz z
 𝗀𝗎𝖺𝗋𝖽 Separation_HomoE_Cond F3 F2 F23 Cr U R Du uz
 (a  Dom (z x).
      a  T  W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f a  U  R 𝗐𝗂𝗍𝗁 P a @tag 𝒯𝒫' )
 SE_Has_or_Not Cw W F4 FW
 SE_Has_or_Not Cr R F2 FR
 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[𝗌𝖺𝖿𝖾] (y, prem, PP) :
        (uz (func_mapper f P (z x)),
         (y = uz (func_mapper f P (z x)) 
              x  Dz  (a. a  Dom (z x)  f a  Rng (z x))
                      func_mapper f P (z x)  Du),
         pred_mapper f P (z x))
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 prem
 x  F1 T  FW 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  F3 U  FR 𝗐𝗂𝗍𝗁 PP @tag 𝒯𝒫'
  unfolding 𝗋Guard_def SE_Has_or_Not_alt_def φProd'_def
   premises FTF[] and SHI[] and SHE[] and Tr and [simp] and [simp]
    apply_rule apply_Separation_HomoI_Cond[where Fu=F4 and Ft=F1, OF SHI, simplified]
    apply_rule apply_Functional_Transformation_Functor[where f=f and P=P, OF FTF, simplified]
     Tr  
    apply_rule apply_Separation_HomoE_Cond[OF SHE, simplified]
   .


subparagraph ‹With Parameterization›

lemma "_Structural_ExtractΛ_general_rule_i_"[φreason_template default %derived_SE_functor]:
  𝗀𝗎𝖺𝗋𝖽 Functional_Transformation_FunctorΛ F14 F23 (λp. T p  ◒[Cw] W p) (λp. U p  ◒[Cr] R p) Dom Rng pred_mapper func_mapper
 𝗀𝗎𝖺𝗋𝖽 Separation_HomoΛI_Cond F1 F4 F14 Cw T W Dz z
 𝗀𝗎𝖺𝗋𝖽 Separation_HomoΛE_Cond F3 F2 F23 Cr U R Du uz
 (p. a  Dom p (z x).
          a  T p  W p 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f p a  U p  R p 𝗐𝗂𝗍𝗁 P p a @tag 𝒯𝒫' )
 SE_Has_or_NotΛ Cw W F4 FW
 SE_Has_or_NotΛ Cr R F2 FR
 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 (y, prem, PP) :
      (uz (func_mapper f P (z x)),
       (y = uz (func_mapper f P (z x)) 
        x  Dz  (p a. a  Dom p (z x)  f p a  Rng p (z x))
                func_mapper f P (z x)  Du),
       pred_mapper f P (z x))
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 prem
 x  F1 T  FW 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  F3 U  FR 𝗐𝗂𝗍𝗁 PP @tag 𝒯𝒫'
  unfolding 𝗋Guard_def SE_Has_or_NotΛ_alt_def φProd'_def
  apply simp
   premises FTF[] and SHI[] and SHE[] and Tr and [simp] and [simp]
    apply_rule apply_Separation_HomoΛI_Cond[where Fu=F4 and Ft=F1, OF SHI, simplified]
    apply_rule apply_Functional_Transformation_FunctorΛ[where f=f and P=P, OF FTF, simplified]
     Tr 
    apply_rule apply_Separation_HomoΛE_Cond[OF SHE, simplified]
   .



paragraph ‹Bi-Functor›

lemma [φreason_template default %derived_SE_functor name F1.separation_extraction]:

  𝗀𝗎𝖺𝗋𝖽 Functional_Transformation_BiFunctor F14 F23
            (T1  ◒[Cw] W1) (T2  ◒[Cw] W2) (U1  ◒[Cr] R1) (U2  ◒[Cr] R2)
            Dom1 Dom2 Rng1 Rng2 pred_mapper func_mapper
 𝗀𝗎𝖺𝗋𝖽 Separation_HomoI2_Cond F1 F4 F14 Cw T1 T2 W1 W2 Dz z
 𝗀𝗎𝖺𝗋𝖽 Separation_HomoE2_Cond F3 F2 F23 Cr U1 U2 R1 R2 Du uz
 (a  Dom1 (z x). a  T1  W1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f1 a  U1  R1 𝗐𝗂𝗍𝗁 P1 a @tag 𝒯𝒫' )
 (a  Dom2 (z x). a  T2  W2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f2 a  U2  R2 𝗐𝗂𝗍𝗁 P2 a @tag 𝒯𝒫' )
 SE_Has_or_Not2 Cw W1 W2 F4 FW
 SE_Has_or_Not2 Cr R1 R2 F2 FR
 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[𝗌𝖺𝖿𝖾] (y, prem, PP) :
        (uz (func_mapper f1 f2 P1 P2 (z x)),
         (y = uz (func_mapper f1 f2 P1 P2 (z x)) 
              x  Dz
               (a. a  Dom1 (z x)  f1 a  Rng1 (z x))
               (a. a  Dom2 (z x)  f2 a  Rng2 (z x))
               func_mapper f1 f2 P1 P2 (z x)  Du),
         pred_mapper f1 f2 P1 P2 (z x))
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 prem
 x  F1 T1 T2  FW 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  F3 U1 U2  FR 𝗐𝗂𝗍𝗁 PP @tag 𝒯𝒫'
  unfolding 𝗋Guard_def SE_Has_or_Not2_alt_def φProd'_def
   premises FTF[] and SHI[] and SHE[] and Tr1 and Tr2 and [simp] and [simp]
    apply_rule apply_Separation_HomoI2_Cond[where Fu=F4 and Ft=F1, OF SHI, simplified]
    apply_rule apply_Functional_Transformation_BiFunctor[where P1=P1 and P2=P2, OF FTF, simplified]
     Tr1 
     Tr2  
    apply_rule apply_Separation_HomoE2_Cond[OF SHE, simplified]
   .

paragraph ‹CV-Functor›

lemma [φreason_template default %derived_SE_functor name F1.separation_extraction]:

  𝗀𝗎𝖺𝗋𝖽 Fun_CV_TrFunctor F14 F23
            (T1  ◒[Cw] W1) (T2  ◒[Cw] W2) (U1  ◒[Cr] R1) (U2  ◒[Cr] R2)
            Dom1 Dom2 FC1 Rng2 pred_mapper func_mapper
 𝗀𝗎𝖺𝗋𝖽 Separation_HomoI2_Cond F1 F4 F14 Cw T1 T2 W1 W2 Dz z
 𝗀𝗎𝖺𝗋𝖽 Separation_HomoE2_Cond F3 F2 F23 Cr U1 U2 R1 R2 Du uz
 (a. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 f1 a  Dom1 (z x)
         a  U1  R1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f1 a  T1  W1 𝗐𝗂𝗍𝗁 P1 a @tag 𝒯𝒫' )
 (a  Dom2 (z x). a  T2  W2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f2 a  U2  R2 𝗐𝗂𝗍𝗁 P2 a @tag 𝒯𝒫' )
 SE_Has_or_Not2 Cw W1 W2 F4 FW
 SE_Has_or_Not2 Cr R1 R2 F2 FR
 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[𝗌𝖺𝖿𝖾] (y, prem, PP) :
        (uz (func_mapper f1 f2 P1 P2 (z x)),
         (y = uz (func_mapper f1 f2 P1 P2 (z x)) 
              x  Dz
               FC1 f1 (z x)
               (a. a  Dom2 (z x)  f2 a  Rng2 (z x))
               func_mapper f1 f2 P1 P2 (z x)  Du),
         pred_mapper f1 f2 P1 P2 (z x))
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 prem
 x  F1 T1 T2  FW 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  F3 U1 U2  FR 𝗐𝗂𝗍𝗁 PP @tag 𝒯𝒫'
  unfolding 𝗋Guard_def SE_Has_or_Not2_alt_def φProd'_def
   premises FTF[] and SHI[] and SHE[] and Tr1 and Tr2 and [simp] and [simp]
    apply_rule apply_Separation_HomoI2_Cond[where Fu=F4 and Ft=F1, OF SHI, simplified]
    apply_rule apply_Functional_CV_BiFunctor[where f1=f1 and P1=P1 and P2=P2, OF FTF, simplified]
     Tr1 
     Tr2 
    apply_rule apply_Separation_HomoE2_Cond[OF SHE, simplified]
   .


subsubsection ‹Transformation Mapper›


context 
  notes φProd_expn''[simp, φprogramming_simps] prod_opr_norm[simp] boolean_conversions[simp]
begin

lemma ToA_mapper_sep_template [φreason_template default %φmapToA_derived_TF name F1.ToA_mapper_sep]:
  𝗀𝗎𝖺𝗋𝖽 Functional_Transformation_Functor F14 F23 (T  ◒[CW] W) (U  ◒[CR] R) Dom Rng pred_mapper func_mapper
 𝗀𝗎𝖺𝗋𝖽 Parameter_Variant_of_the_Same_TypOpr F14 F14'
 𝗀𝗎𝖺𝗋𝖽 Functional_Transformation_Functor F23' F14' (U'  ◒[CR] R') (T'  ◒[CW] W') Dom' Rng' pred_mapper' func_mapper'
 𝗀𝗎𝖺𝗋𝖽 Separation_HomoI_Cond F1 F4 F14 CW T W Dz z
 𝗀𝗎𝖺𝗋𝖽 Separation_HomoI_Cond F3' F2' F23' CR U' R' Dz' z'
 𝗀𝗎𝖺𝗋𝖽 Separation_HomoE_Cond F3 F2 F23 CR U R Du uz
 𝗀𝗎𝖺𝗋𝖽 Separation_HomoE_Cond F1' F4' F14' CW T' W' Du' uz'
 compositional_mapper m1 (λh. func_mapper h (λ_. True)) m2 Dm1 (g f r) h @tag 𝒜_template_reason undefined
 separatable_cond_unzip CR z' uz Dus m1 mg mr g r @tag 𝒜_template_reason undefined
 compositional_mapper (λs. func_mapper' s (λ_. True)) m2 m3 Dm2 s (g f r o h) @tag 𝒜_template_reason undefined
 separatable_cond_zip CW uz' z Dzs m3 mf mw f w @tag 𝒜_template_reason undefined
 domain_by_mapper Dom' m2 Dom (g f r o h) Ddm @tag 𝒜_template_reason undefined
 domain_of_inner_map m3 Dm3 @tag 𝒜_template_reason undefined

 𝗆𝖺𝗉 g f r : U  R  U'  R'
    𝗈𝗏𝖾𝗋 f f w : T  W  T'  W'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s 𝗂𝗇  (Dom ` z ` D)

 SE_Has_or_Not CW W  F4  FW
 SE_Has_or_Not CW W' F4' FW'
 SE_Has_or_Not CR R  F2  FR
 SE_Has_or_Not CR R' F2' FR'
 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇[𝗌𝖺𝖿𝖾] (CR  r = (λ_. unspec))  (CW  w = (λ_. unspec))

 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (xD.
      x  Dz  x  Dzs  z x  Dm1  z x  Dm2  z x  Ddm 
      (a  Dm3 (z x). a  Dom (z x)) 
      (a  Dom (z x). h a  Rng (z x)) 
      (let x1 = func_mapper h  (λ_. True) (z x) in
            x1  Du  x1  Dus 
            (mg g f mr r) (uz x1)  Dz' 
            (a  Dom' (m2 (g f r o h) (z x)). s a  Rng' (m2 (g f r o h) (z x))) 
            m3 (f f w) (z x)  Du') )

 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 h' : uz o func_mapper h (λ_. True) o z @tag 𝒜_template_reason undefined
 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 s' : uz' o func_mapper' s (λ_. True) o z' @tag 𝒜_template_reason undefined
 𝗆𝖺𝗉 mg g f mr r : F3 U  FR  F3' U'  FR'
    𝗈𝗏𝖾𝗋 mf f f mw w : F1 T  FW  F1' T'  FW'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h' 𝗌𝖾𝗍𝗍𝖾𝗋 s' 𝗂𝗇 D

  unfolding 𝗋Guard_def Action_Tag_def separatable_unzip_def compositional_mapper_def
            separatable_zip_def domain_of_inner_map_def NO_SIMP_def domain_by_mapper_def
            separatable_cond_unzip_def separatable_cond_zip_def φProd'_def SE_Has_or_Not_alt_def
   premises FTF[] and [] and FTF'[] and SHI[] and SHI'[] and SHE[] and SHE'[]
         and [useful] and [useful] and [useful] and [useful] and [useful] and [] and Tr
         and [simp] and [simp] and [simp] and [simp] and _
         and _ and [simp] and [simp]
    apply_rule apply_Separation_HomoI_Cond[OF SHI, simplified]
    apply_rule apply_Functional_Transformation_Functor[where f=h and P=λ_. True, OF FTF, simplified]
     apply_rule ToA_Mapper_onward[OF Tr, simplified] 
    apply_rule apply_Separation_HomoE_Cond[OF SHE, simplified] certified by (metis the_φ(3) the_φ(4))
   apply (rule conjunctionI, rule, simp add: image_image del: split_paired_All)
   premises FTF[] and [] and FTF'[] and SHI[] and SHI'[] and SHE[] and SHE'[]
         and [useful] and [useful] and [useful] and [useful] and DM and DiM and Tr
         and [simp] and [simp] and [simp] and [simp] and t1
         and _ and [simp] and [simp]
    apply_rule apply_Separation_HomoI_Cond[OF SHI', simplified]
    certified by (instantiate x, insert useful(1), simp add: image_iff, elim bexE, metis the_φ(4)) ;;
  
    apply_rule apply_Functional_Transformation_Functor[where f=s and P=λ_. True, OF FTF', simplified]
     for a
      apply_rule ToA_Mapper_backward[OF Tr, simplified]
      certified proof (instantiate a,
                      insert a  Dom' (z' x) x  (λx. (mg g f mr r) (uz (func_mapper h (λ_. True) (z x)))) ` D,
                      simp add: image_iff, elim bexE)
                  fix xa :: "'o × 'p"
                  assume a1: "xa  D"
                  assume a2: "a  Dom' (z' x)"
                  assume a3: "x = (mg g f mr r) (uz (func_mapper h (λ_. True) (z xa)))"
                  have t1: "func_mapper h (λp. True) (z xa)  Dus"
                    using a1 by (metis (no_types) the_φ(5))
                  show "pD. pDom (z p). a = (g f r) (h p)"
                  proof (rule bexI[OF _ a1])
                    have "P p f. pa. ((p::'l × 'm)  f ` P  (pa::'a × 'b)  P)  (p  f ` P  f pa = p)"
                      by blast
                    then show "pDom (z xa). a = (g f r) (h p)"
                      by (cases CR,
                          smt (z3) DM a1 a2 a3 subsetD the_φ(10) the_φ(11) the_φ(5),
                          smt (z3) DM a1 a2 a3 subsetD the_φ(10) the_φ(11) the_φ(5) the_φ(7))
                  qed
                qed 
      certified by (insert useful(1), simp add: image_iff, elim bexE,
                      metis the_φ(3) the_φ(5) the_φ(8) the_φ(9)) 
    apply_rule apply_Separation_HomoE_Cond[OF SHE', simplified]
        certified proof -
          obtain y where t1: y  D and t2: x = (mg g f mr r) (uz (func_mapper h (λ_. True) (z y)))
            by (insert useful(2), blast)
          have t3: Dm3 (z y)  Dom (z y)
            using t1 the_φ(4) by fastforce
          have t4: m3 (s  (g f r  h)) (z y) = m3 (f f w) (z y)
            by (insert ToA_Mapper_f_expn[OF Tr], clarsimp,
                metis (mono_tags, opaque_lifting) DiM comp_apply t1 the_φ(4))
          show ?thesis
            by (insert xD. _[THEN bspec[OF _ t1]], simp add: t2 t4[symmetric],
                metis the_φ(10) the_φ(6) the_φ(8) the_φ(9))
        qed
   apply (rule conjunctionI, simp, drule ToA_Mapper_f_expn,
        simp add: Premise_def Simplify_def subset_iff del: split_paired_All,
        rule)
    subgoal premises prems for x
    proof -
      have t1: Dm3 (z x)  Dom (z x)
        using prems(19) prems(23) by blast
      have t2: m3 (s  (g f r  h)) (z x) = m3 (f f w) (z x)
        by (rule f g x. (aDm3 x. f a = g a)  m3 f x = m3 g x[THEN spec, THEN spec, THEN spec, THEN mp],
            insert prems(22) prems(23) t1, fastforce)
      show ?thesis
        by (metis prems(10) prems(11) prems(18) prems(19) prems(23) prems(8) prems(9) t2)
    qed .





lemma ToA_mapper_template[φreason_template default %φmapToA_derived_TF name F1.ToA_mapper]:
  𝗀𝗎𝖺𝗋𝖽 Functional_Transformation_Functor F1 F2 T U Dom Rng pred_mapper func_mapper
 𝗀𝗎𝖺𝗋𝖽 Parameter_Variant_of_the_Same_TypOpr F1 F1'
 𝗀𝗎𝖺𝗋𝖽 Functional_Transformation_Functor F2' F1' U' T' Dom' Rng' pred_mapper' func_mapper'

 compositional_mapper m1 (λh. func_mapper h (λ_. True)) m2 Dm1 g h @tag 𝒜_template_reason undefined
 compositional_mapper (λs. func_mapper' s (λ_. True)) m2 m3 Dm2 s (g o h) @tag 𝒜_template_reason undefined
 domain_by_mapper Dom' m2 Dom (g o h) Ddm @tag 𝒜_template_reason undefined
 domain_of_inner_map m3 Dm3 @tag 𝒜_template_reason undefined

 𝗆𝖺𝗉 g : U  U' 𝗈𝗏𝖾𝗋 f : T  T'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s 𝗂𝗇  (Dom ` D)

 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (xD.
      x  Dm1  x  Dm2  x  Ddm 
      (a  Dm3 x. a  Dom x) 
      (a  Dom x. h a  Rng x) 
      (let x1 = func_mapper h (λ_. True) x in
            (a  Dom' (m2 (g o h) x). s a  Rng' (m2 (g o h) x)) ))

 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 h' : func_mapper h (λ_. True) @tag 𝒜_template_reason undefined
 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 s' : func_mapper' s (λ_. True) @tag 𝒜_template_reason undefined
 𝗆𝖺𝗉 m1 g : F2 U  F2' U' 𝗈𝗏𝖾𝗋 m3 f : F1 T  F1' T'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h' 𝗌𝖾𝗍𝗍𝖾𝗋 s' 𝗂𝗇 D

  unfolding 𝗋Guard_def Action_Tag_def compositional_mapper_def
            domain_of_inner_map_def NO_SIMP_def domain_by_mapper_def
   premises FTF[] and [] and FTF'[] and [useful] and [useful] and [useful] and [useful] and Tr
         and _ and [simp] and [simp]
    apply_rule apply_Functional_Transformation_Functor[where U=U and f=h and P=λ_. True, OF FTF]
     apply_rule ToA_Mapper_onward[OF Tr] 
   apply (rule conjunctionI, rule)
   premises FTF[] and [] and FTF'[] and [useful] and [useful] and [useful] and [useful] and Tr
         and _ and [simp] and [simp]
    apply_rule apply_Functional_Transformation_Functor[where f=s and P=λ_. True, OF FTF']
     for a apply_rule ToA_Mapper_backward[OF Tr]
      certified by (insert a  Dom' x x  m1 g ` func_mapper h (λ_. True) ` D,
                      simp add: image_iff, elim bexE,
                      insert the_φ(4) the_φ(6) the_φ(8), fastforce)
    
  
  by (rule conjunctionI, simp, drule ToA_Mapper_f_expn,
      simp add: Premise_def Simplify_def subset_iff del: split_paired_All)




end


subsubsection ‹Semimodule Scalar Associative \label{Semimodule-Scalar-Associative}›

text ‹The proof search is inefficient for semimodule φ-type that satisfies both scalar associativity
  and scalar distributivity.
  This inefficiency stems from the two properties deriving rules that can be interchangeably applied.
  Given a φ-type F a T› and expect F b U› with a ≠ b›, we might identify some c› with c * a = b›,
  so we apply the associative rule and go to element transformations expecting the inner φ-type T›
  might supply the missing F c U›;
  alternatively we can also identify a certain c› with c + a = b›, so we apply the distributive rule
  and hope the unexplored external portion of assertion contains the F c U›.
  The situation is further complicated when the two rules are combined: the inner φ-type T› may
  contain some part c1 while the external part contains the remaining part c2,
  c2 + c1 * a = b›.

  To tackle this complexity, we introduce a normalization step before the reasoning,
  where we exhaustively apply the associative rules to eliminate any further need for them in the later reasoning.
  Viewing a φ-type expression as a tree with type operators as nodes and atomic types as leaves,
  we push every module-like type operators F a T› all the way down to the leaves, passing through type
  connectives like ∗› and  by meas of homomorphic rules like F a (T ∗ U) = (F a T) ∗ (F a U)›.
  In this way, all the module operator are gathered at the leaves.
  By exhaustively applying the associative rules on them, any need of associative rules
  is fully addressed, and consequently, in the subsequent reasoning, we can exclusively focus on
  the scalar distribution rules.

  Sure it raises further works for deriving the homomorphic rules. It can be done by a deriver generating
  that ....
›

text ‹According to the discussion above, the rule below should be used only for non-distributive scalars.›

(*preserved for documenting

lemma SE_general_Semimodule_Scalar_left: (*need test, to be tested once we have usable test case*)
  ‹ 𝗀𝗎𝖺𝗋𝖽 (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 c * a = b) ∧𝗋 Prem
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ds a ∧ Ds b ∧ Ds c
⟹ Functional_Transformation_Functor F14 F23 Dom Rng mapper Prem pred_mapper func_mapper
⟹ Module_Assoc F3 U Ds
⟹ Module_Assoc F4 W Ds
⟹ Separation_HomoI (F1 a) (F4 a) F14 T (F4 c W) Dz z
⟹ Separation_HomoE (F3 a) (F2 a) F23 (F3 c U) R uz
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x ∈ Dz ∧ (∀a. a ∈ Dom (z x) ⟶ f a ∈ Rng (z x))
⟹ (⋀x ∈ Dom (z x). x ⦂ T ∗ F4 c W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x ⦂ F3 c U ∗ R 𝗐𝗂𝗍𝗁 P x @tag 𝒜SE )
⟹ x ⦂ F1 a T ∗ F4 b W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 uz (func_mapper f P (z x)) ⦂ F3 b U ∗ F2 a R 𝗐𝗂𝗍𝗁 pred_mapper f P (z x) @tag 𝒜SE ›
  unfolding 𝗋Guard_def Ant_Seq_imp
  ❴ premises _ and [φreason add] and _
         and FTF and LSF3[φreason add] and LSF4[φreason add] and _ and _
         and _ and Tr
    interpret Functional_Transformation_Functor F14 F23 Dom Rng mapper Prem pred_mapper func_mapper
      using FTF .
    have F4D: ‹F4 b W = F4 a (F4 c W)›
      by (simp add: ‹Ds a ∧ Ds b ∧ Ds c› the_φ(6))
    have F3D: ‹F3 b U = F3 a (F3 c U)›
      by (simp add: ‹Ds a ∧ Ds b ∧ Ds c› the_φ(6)) ;;
    unfold F4D
    apply_rule apply_Separation_HomoI[where Fu=‹F4 a› and Ft=‹F1 a›]
    apply_rule functional_transformation[where U=‹F3 c U ∗ R› and f=f and P=P]
    ❴ Tr ❵
    apply_rule apply_Separation_HomoE[where x=‹func_mapper f P (z x)›]
    fold F3D
  ❵ .

declare SE_general_Semimodule_Scalar_left[THEN 𝒜SE_clean_waste, φreason_template default 30]
  ― ‹The priority is smaller than the default rule of functional transformation›
*)

lemma SE_Semimodule_Scalar_right
      [φreason_template default %derived_SE_scalar_assoc name: F3b.ToR_scala_assoc_right]:
  𝗀𝗎𝖺𝗋𝖽 common_multiplicator_2 smul a c b
 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Da a  Dc c
 Module_AssocI F3a F3c F3b U Da Dc Dx smul gs
 Type_Variant_of_the_Same_Scalar_Mul F3a F1
 Type_Variant_of_the_Same_Scalar_Mul F3a F4
 Type_Variant_of_the_Same_Scalar_Mul F3a F2
 Functional_Transformation_Functor (F1 a) (F3a a) T (F3c c U) Dom Rng pred_mapper func_mapper
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (a. a  Dom x  f a  Rng x)  Dx a c (func_mapper f P x)
 (x  Dom x. x  T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x  F3c c U 𝗐𝗂𝗍𝗁 P x @tag 𝒯𝒫)
 x  F1 a T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 gs a c (func_mapper f P x)  F3b b U
    𝗐𝗂𝗍𝗁 pred_mapper f P x @tag 𝒯𝒫
  unfolding 𝗋Guard_def common_multiplicator_2_def
   premises [simp] and _ and SA[] and _ and _ and _ and FTF[] and _ and Tr[]
    apply_rule apply_Functional_Transformation_Functor[where f=f and P=P, OF FTF]
     Tr 
    apply_rule apply_Semimodule_SAssocI[OF SA]
   .

lemma SE_Semimodule_Scalar_left
      [φreason_template default %derived_SE_scalar_assoc name: F1b.ToR_scala_assoc_left]:
  𝗀𝗎𝖺𝗋𝖽 common_multiplicator_2 smul a c b
 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Da a  Dc c
 Module_AssocE F1a F1c F1b T Da Dc Dx smul gs
 Type_Variant_of_the_Same_Scalar_Mul F1a F3
 Type_Variant_of_the_Same_Scalar_Mul F1a F4
 Type_Variant_of_the_Same_Scalar_Mul F1a F2
 Functional_Transformation_Functor (F1a a) (F3 a) (F1c c T) U Dom Rng pred_mapper func_mapper
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Dx a c x  (e  Dom (gs a c x). f e  Rng (gs a c x)) 
           func_mapper f P (gs a c x)  Du
 (x  Dom (gs a c x). x  F1c c T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x  U 𝗐𝗂𝗍𝗁 P x @tag 𝒯𝒫 )
 x  F1b b T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 func_mapper f P (gs a c x)  F3 a U
    𝗐𝗂𝗍𝗁 pred_mapper f P (gs a c x) @tag 𝒯𝒫
  unfolding 𝗋Guard_def common_multiplicator_2_def
   premises A and _ and SA[] and _ and _ and _ and FTF[] and _ and Tr[]
    apply_rule apply_Semimodule_SAssocE[where s=a and t=c and smul=smul, OF SA, unfolded A]
    apply_rule apply_Functional_Transformation_Functor[where f=f and P=P, OF FTF]
     Tr 
   .



lemma SE_Semimodule_Scalar_partial_right:
  𝗀𝗎𝖺𝗋𝖽 common_multiplicator_2 smul a c b
 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Da a  Dc c
 Module_AssocI F3a F3c F3b U Da Dc Dx smul gs
 Type_Variant_of_the_Same_Scalar_Mul F3a F1
 Type_Variant_of_the_Same_Scalar_Mul F3a F4
 Type_Variant_of_the_Same_Scalar_Mul F3a F2
 Separation_HomoI_Cond (F1 a) (F4 a) F14 CW T W Dz z
 Separation_HomoE_Cond (F3a a) (F2 a) F23 CR (F3c c U) R Du uz
 Functional_Transformation_Functor F14 F23 (T  ◒[CW] W) (F3c c U  ◒[CR] R) Dom Rng pred_mapper func_mapper
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x  Dz  (a. a  Dom (z x)  f a  Rng (z x)) 
           func_mapper f P (z x)  Du 
           Dx a c (fst (uz (func_mapper f P (z x))))
 (a  Dom (z x). a  T  W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f a  F3c c U  R 𝗐𝗂𝗍𝗁 P a @tag 𝒯𝒫' )
 SE_Has_or_Not CW W (F4 a) FW
 SE_Has_or_Not CR R (F2 a) FR
 x  F1 a T  FW
    𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 apfst (gs a c) (uz (func_mapper f P (z x)))  F3b b U  FR
    𝗐𝗂𝗍𝗁 pred_mapper f P (z x) @tag 𝒯𝒫'
  unfolding 𝗋Guard_def common_multiplicator_2_def φProd'_def SE_Has_or_Not_alt_def
   premises [simp] and _ and SA and _ and _ and _ and SHI and SHE and FTF and _ and Tr and [simp] and [simp]
    apply_rule apply_Separation_HomoI_Cond[OF SHI, simplified]
    apply_rule apply_Functional_Transformation_Functor[where f=f and P=P, OF FTF, simplified]
     Tr  certified by auto_sledgehammer 
    apply_rule apply_Separation_HomoE_Cond[OF SHE, simplified]
    apply_rule apply_Semimodule_SAssocI[OF SA, THEN transformation_right_frame_ty, simplified]
   .

declare SE_Semimodule_Scalar_partial_right[(*THEN SE_clean_waste,*)
    φreason_template default %derived_SE_scalar_assoc name: F3b.ToR_scala_assoc_partial_right]


lemma SE_Semimodule_Scalar_partial_left
      [φreason_template default %derived_SE_scalar_assoc name: F1b.ToR_scala_assoc_partial_left]:
  𝗀𝗎𝖺𝗋𝖽 common_multiplicator_2 smul a c b
 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Da a  Dc c
 Module_AssocE F1a F1c F1b T Da Dc Dx smul gs
 Type_Variant_of_the_Same_Scalar_Mul F1a F3
 Type_Variant_of_the_Same_Scalar_Mul F1a F4
 Type_Variant_of_the_Same_Scalar_Mul F1a F2
 Separation_HomoI_Cond (F1a a) (F4 a) F14 CW (F1c c T) W Dz z
 Separation_HomoE_Cond (F3 a) (F2 a) F23 CR U R Du uz
 Functional_Transformation_Functor F14 F23 (F1c c T  ◒[CW] W) (U  ◒[CR] R) Dom Rng pred_mapper func_mapper
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 apfst (gs a c) x  Dz  Dx a c (fst x) 
           (x'  Dom (z (apfst (gs a c) x)). f x'  Rng (z (apfst (gs a c) x))) 
           func_mapper f P (z (apfst (gs a c) x))  Du
 (a  Dom (z (apfst (gs a c) x)). a  F1c c T  W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f a  U  R 𝗐𝗂𝗍𝗁 P a @tag 𝒯𝒫')
 SE_Has_or_Not CW W (F4 a) FW
 SE_Has_or_Not CR R (F2 a) FR
 x  F1b b T  FW
    𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 uz (func_mapper f P (z (apfst (gs a c) x)))  F3 a U  FR
    𝗐𝗂𝗍𝗁 pred_mapper f P (z (apfst (gs a c) x)) @tag 𝒯𝒫'
  unfolding 𝗋Guard_def common_multiplicator_2_def φProd'_def SE_Has_or_Not_alt_def
   premises A and _ and SA[] and _ and _ and _ and SHI[] and SHE[] and FTF[] and _ and Tr[] and [simp] and [simp]
    apply_rule apply_Semimodule_SAssocE[where s=a and t=c and smul=smul, OF SA, unfolded A, simplified]
    apply_rule apply_Separation_HomoI_Cond[OF SHI, simplified]
    apply_rule apply_Functional_Transformation_Functor[where f=f and P=P, OF FTF, simplified]
     Tr 
    apply_rule apply_Separation_HomoE_Cond[OF SHE, simplified]
   .

paragraph ‹Transformation Mapper›


lemma SE_Module_scalar_assoc_mapper_tgt_template
      [no_atp, φreason_template default %φmapToA_derived_module_assoc name F3b.assoc_mapper_tgt]:
  𝗀𝗎𝖺𝗋𝖽 common_multiplicator_2 smul a c b
 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 a' = a  b' = b  Da a  Dc c
 Module_AssocI F3a F3c F3b U Da Dc Dx smul gI
 Type_Variant_of_the_Same_Scalar_Mul F3a F3a'
 Type_Variant_of_the_Same_Scalar_Mul F3a F1
 Type_Variant_of_the_Same_Scalar_Mul F3a F1'
 Module_AssocE F3a' F3c' F3b' U' Da Dc Dx' smul gE

 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (xD. Dx a c (fst (h x))  Dx' a c (g (gI a c (fst (h x)))))

 𝗆𝖺𝗉 (gE a c o g o gI a c) f r : F3a a (F3c c U)  R  F3a' a (F3c' c U')  R'
    𝗈𝗏𝖾𝗋 f f w : F1 a T  W  F1' a T'  W'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s
      𝗂𝗇 D

 𝗆𝖺𝗉 g f r : F3b b U  R  F3b' b' U'  R'
    𝗈𝗏𝖾𝗋 f f w : F1 a T  W  F1' a' T'  W'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 apfst (gI a c) o h 𝗌𝖾𝗍𝗍𝖾𝗋 s o apfst (gE a c)
      𝗂𝗇 D
  unfolding 𝗋Guard_def common_multiplicator_2_def φProd'_def
 premises A and _ and SAI[] and [] and [] and [] and SAE[] and _ and Tr[]
  apply_rule ToA_Mapper_onward[OF Tr, where x=x]
  apply_rule apply_Semimodule_SAssocI[where s=a and t=c, OF SAI, unfolded A]
 apply (rule conjunctionI, rule)
 premises A and B and SAI[] and [] and [] and [] and SAE[] and _ and Tr[] 
  unfold b' = b
  apply_rule apply_Semimodule_SAssocE[where s=a and t=c, OF SAE, unfolded A]
    certified by auto_sledgehammer ;;
  apply_rule ToA_Mapper_backward[OF Tr, where x=apfst (gE a c) x]
    certified by (insert ToA_Mapper_f_expn[OF Tr], auto_sledgehammer) ;;
  fold a' = a
 by (rule conjunctionI, rule, drule ToA_Mapper_f_expn, clarsimp simp: prod.map_beta)


lemma SE_Module_scalar_assoc_mapper_src_template
      [no_atp, φreason_template default %φmapToA_derived_module_assoc name F3b.assoc_mapper_src]:
  𝗀𝗎𝖺𝗋𝖽 common_multiplicator_2 smul a c b
 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 a' = a  b' = b  Da a  Dc c
 Module_AssocE F3a F3c F3b U Da Dc Dx smul gE
 Type_Variant_of_the_Same_Scalar_Mul F3a F3a'
 Type_Variant_of_the_Same_Scalar_Mul F3a F1
 Type_Variant_of_the_Same_Scalar_Mul F3a F1'
 Module_AssocI F3a' F3c' F3b' U' Da Dc Dx' smul gI

 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (xD. Dx a c (fst x)  Dx' a c (f (gE a c (fst x))))

 𝗆𝖺𝗉 g f r : F1 a T  R  F1' a T'  R'
    𝗈𝗏𝖾𝗋 f f w : F3a a (F3c c U)  W  F3a' a (F3c' c U')  W'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s
      𝗂𝗇 apfst (gE a c) ` D

 𝗆𝖺𝗉 g f r : F1 a T  R  F1' a' T'  R'
    𝗈𝗏𝖾𝗋 (gI a c o f o gE a c) f w : F3b b' U  W  F3b' b U'  W'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h o apfst (gE a c) 𝗌𝖾𝗍𝗍𝖾𝗋 apfst (gI a c) o s
      𝗂𝗇 D
  unfolding 𝗋Guard_def common_multiplicator_2_def φProd'_def
  apply (simp add: φProd_expn'' φProd_expn' )

 premises A and _ and SAE[] and [] and [] and [] and SAI[] and _ and Tr[]
  unfold b' = b
  apply_rule apply_Semimodule_SAssocE[where s=a and t=c, OF SAE, unfolded A]
  apply_rule ToA_Mapper_onward[OF Tr, where x=apfst (gE a c) x]
 apply (rule conjunctionI, rule)
 premises A and _ and SAE[] and [] and [] and [] and SAI[] and _ and Tr[]
  unfold a' = a
  apply_rule ToA_Mapper_backward[OF Tr, where x=x]
  apply_rule apply_Semimodule_SAssocI[where s=a and t=c, OF SAI, unfolded A]
  certified by (insert ToA_Mapper_f_expn[OF Tr], auto_sledgehammer)
 by (rule conjunctionI, rule, drule ToA_Mapper_f_expn, clarsimp, auto_sledgehammer)




subparagraph ‹With Parameterization›

(* TODO!
lemma SE_general_Semimodule_Scalar_left_b: (*need test, to be tested once we have usable test case*)
  ‹ 𝗀𝗎𝖺𝗋𝖽 (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 smul a c = b)
⟹ 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Da a ∧ Dc c
⟹ Functional_Transformation_FunctorΛ F14 F23 (T ∗[Cw] W) (F3c c U ∗[Cr] R) Dom Rng pred_mapper func_mapper
⟹ Module_AssocI F3a F3c F3b U Da Dc Dx smul gs
⟹ Separation_HomoI_Cond (F1 a) (F4 a) F14 Cw T W Dz z
⟹ Separation_HomoE_Cond (F3a a) (F2 a) F23 Cr (F3c c U) R Du uz
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x ∈ Dz ∧ (∀a. a ∈ Dom (z x) ⟶ f a ∈ Rng (z x)) ∧
           func_mapper f P (z x) ∈ Du ∧
           Dx a c (fst (uz (func_mapper f P (z x))))
⟹ (⋀x ∈ Dom (z x). x ⦂ T ∗[Cw] W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x ⦂ F3c c U ∗[Cr] R 𝗐𝗂𝗍𝗁 P x )
⟹ x ⦂ F1 a T ∗[Cw] F4 a W
    𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 apfst (gs a c) (uz (func_mapper f P (z x))) ⦂ F3b b U ∗[Cr] F2 a R
    𝗐𝗂𝗍𝗁 pred_mapper f P (z x) ›
  unfolding 𝗋Guard_def
  ❴ premises [simp] and _ and FTF and SA and SHI and SHE and _ and Tr
   ;; apply_rule apply_Separation_HomoI_Cond[OF SHI]
    apply_rule apply_Functional_Transformation_Functor[where f=f and P=P, OF FTF]
    ❴ Tr ❵
    apply_rule apply_Separation_HomoE_Cond[OF SHE]
    apply_rule apply_Semimodule_SAssocI[OF SA, THEN transformation_right_frame_conditioned_ty]
  ❵ .
*)


subsection ‹Separation Extraction of Semimodule Left Distributivity›

paragraph ‹Commutative, Non-Unital Associative, No Additive Zero›

text ‹Non-unital algebra implies no additive zero.›

ML_file ‹library/phi_type_algebra/semimodule_rule_pass.ML›

(* [--d--][-----a-----]
   [-----b-----][--c--]
   Give a, expect b; Need d, remain c.
   d, c ≠ 0; the scalar has to be non-commutative, otherwise reduces to either ‹SE_Module_SDistr_da_b_i› or ‹SE_Module_SDistr_a_cb_i›
   as we assume non-commutative scalar, the concrete algebra must be commutative
*)
lemma SE_Module_SDistr_da_bc
      [φreason_template default %derived_SE_sdistr pass: phi_TA_Module_Distrib_rule_pass_no_comm_scalar]:
  NO_SIMP (𝗀𝗎𝖺𝗋𝖽 dabc_equation d a b c)
 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoS F1 Ds Dx uz
 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoZ F1 Ds Dx' z
 Type_Variant_of_the_Same_Scalar_Mul0 F1 F3
 NO_MATCH (a'::'s'::partial_ab_semigroup_add) a @tag 𝒜_template_reason None
 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ds a  Ds d  Ds c  Ds b
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Dx' d a (xd, fst x)  Dx b c (z d a (xd, fst x))
 (fst (uz b c (z d a (xd, fst x))), w)  F1 b  W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  F3 b  R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'
 snd x  WW 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (xd, w)  F1 d  W @clean
 (snd y, snd (uz b c (z d a (xd, fst x))))  R  F1 c 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 rr  RR @clean
 x  F1 a  WW 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (fst y, rr)  F3 b  RR 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'
  for W :: ('c::sep_algebra,'d) φ 
  unfolding Action_Tag_def 𝗋Guard_def NO_SIMP_def φProd'_def
  apply (drule dabc_equation_D_main,
         simp add: φProd_expn'' φProd_expn' φSome_φProd[symmetric])
   premises SDU[] and SDZ[] and _ and _ and _ and Tr[] and C1[] and C2 and b[simp]
    C1
    apply_rule apply_Module_Distr_HomoZ[where s=d and t=a and F=F1 and x=(xd, fst x), OF SDZ]
    apply_rule apply_Module_Distr_HomoS[where s=b and t=c and F=F1, OF SDU]
    Tr
    C2
   .


(* [-----a-----][--d--]
   [--c--][-----b-----]
   Give a, expect b; Need d, remain c.
   d, c ≠ 0; the scalar has to be non-commutative, otherwise reduces to either ‹SE_Module_SDistr_da_b_i› or ‹SE_Module_SDistr_a_cb_i›
   as we assume non-commutative scalar, the concrete algebra must be commutative
*)
lemma SE_Module_SDistr_ad_cb
      [φreason_template default %derived_SE_sdistr pass: phi_TA_Module_Distrib_rule_pass_no_comm_scalar]:
  NO_SIMP (𝗀𝗎𝖺𝗋𝖽 dabc_equation c b a d)
 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoS F1 Ds Dx uz
 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoZ F1 Ds Dx' z
 Type_Variant_of_the_Same_Scalar_Mul0 F1 F3
 NO_MATCH (a'::'s'::partial_ab_semigroup_add) a @tag 𝒜_template_reason None
 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ds a  Ds d  Ds c  Ds b
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Dx' a d (fst x, fst xw)  Dx c b (z a d (fst x, fst xw))
 (snd (uz c b (z a d (fst x, fst xw))), snd xw)  F1 b  W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  F3 b  R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'
 snd x  W' 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 xw  F1 d  W @clean
 (fst (uz c b (z a d (fst x, fst xw))), snd y)  F1 c  R 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 r'  R' @clean
 x  F1 a  W' 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (fst y, r')  F3 b  R' 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'
  for W :: ('c::sep_algebra,'d) φ
  unfolding Action_Tag_def 𝗋Guard_def NO_SIMP_def φProd'_def
  apply (drule dabc_equation_D_main;
         simp add: φProd_expn'' φProd_expn' φSome_φProd[symmetric] )
   premises _ and _ and _ and [simp] and [simp] and Tr[] and C1[] and C2 and [simp]
    note φProd_expn''[simp] φProd_expn'[simp]
     C1
      apply_rule apply_Module_Distr_HomoZ[where s=a and t=d and F=F1 and x=(fst x, fst xw)]
      apply_rule apply_Module_Distr_HomoS[where s=c and t=b and F=F1, simplified]
      Tr
      C2
   .



(* [---------a---------]
   [--d--][--b--][--c--]
   Give a, expect b, remain d, c.
   d, c ≠ 0; scalar has to be non-commutative; otherwise go ‹SE_Module_SDistr_a_cb_i›*) 
lemma SE_Module_SDistr_a_dbc
      [φreason_template default %derived_SE_sdistr+1]:
  ― ‹Boundary situations (when c or d equals zero) are captured here, so the rule has a higher priority
      than SE_Module_SDistr_da_bc_nc_i› and SE_Module_SDistr_ad_cb_nc_i› in order to preempt the
      boundary situations.›
  NO_SIMP (𝗀𝗎𝖺𝗋𝖽 equation31_cond Cd Cc d b db c a)
 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoS F1 Ds Dx uz
 Type_Variant_of_the_Same_Scalar_Mul0 F1 F3
 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (Cc  Ds c  Ds db)  (Cd  Ds d  Ds b)
 𝗀𝗎𝖺𝗋𝖽 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 x' : (snd (?sL Cd (uz d b) (fst (?sR Cc (uz db c) (fst x)))), snd x)
 𝗀𝗎𝖺𝗋𝖽 x'  F1 b  W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  F3 b  R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'
 (A w. 𝗀𝗎𝖺𝗋𝖽 𝗋Comm_Mul A (w  W))
 (x A. 𝗀𝗎𝖺𝗋𝖽 𝗋Comm_Mul (x  ◒[Cd] F1 d) A)
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (Cc  Dx db c (fst x))  (Cd  Dx d b (fst (?sR Cc (uz db c) (fst x))))
 (snd y, fst (?sL Cd (uz d b) (fst (?sR Cc (uz db c) (fst x)))), snd (?sR Cc (uz db c) (fst x)))  R  ◒[Cd] F1 d  ◒[Cc] F1 c
      𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 r  R' @clean
 x  F1 a  W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (fst y, r)  F3 b  R' 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'
  for R :: ('c::sep_monoid,'d) φ
  unfolding Action_Tag_def 𝗋Guard_def NO_SIMP_def φProd'_def
   premises [unfolded equation31_cond_def, simp] and SU[] and _ and _ and _ and Tr[] and swap1 and swap2 and _ and CC[]
     apply_rule apply_Module_Distr_HomoS_RCond[OF SU, where s=db and t=c and r=a and C=Cc]
      apply_rule apply_Module_Distr_HomoS_LCond[OF SU, where s=d and t=b and r=db and C=Cd]
      apply_rule 𝗋Comm_Mul.apply[OF swap2[where A=x  F1 b for x]]
      apply_rule 𝗋Comm_Mul.apply[
            OF swap1[where A=(x  ◒[Cd] F1 d) * (y  ◒[Cc] F1 c) for x y],
            THEN transformation_left_frame[where R=x  F1 b for x]]
      Tr
      apply_rule CC[THEN transformation_left_frame[where R=x  F3 b for x]]
   .


(* [--d--][--a--][--c--]
   [---------b---------]
   Give a, expect b, need d, c.
   d, c ≠ 0; scalar has to be non-commutative; otherwise go to ‹SE_Module_SDistr_da_b_i› *)
lemma SE_Module_SDistr_dac_b
      [φreason_template default %derived_SE_sdistr+1]:
  ― ‹Boundary situations (when c or d equals zero) are captured here, so the rule has a higher priority
      than SE_Module_SDistr_da_bc_nc_i› and SE_Module_SDistr_ad_cb_nc_i› in order to preempt the
      boundary situations.›
  NO_SIMP (𝗀𝗎𝖺𝗋𝖽 equation31_cond Cd Cc d a da c b)
 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoZ F1 Ds Dx z
 Type_Variant_of_the_Same_Scalar_Mul0 F1 F3
 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (Cd  Ds d  Ds a)  (Cc  Ds da  Ds c)
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (Cd  Dx d a (xd, fst x)) 
           (Cc  Dx da c (?jL Cd (z d a) (xd, fst x), xc))
 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 x' : (?jR Cc (z da c) (?jL Cd  (z d a) (xd, fst x), xc), w)
 x'  F1 b  W 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  F3 b  R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'
 (x A. 𝗀𝗎𝖺𝗋𝖽 𝗋Comm_Mul A (x  ◒[Cd] F1 d))
 snd x  W' 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (xd, xc, w)  ◒[Cd] F1 d  ◒[Cc] F1 c  W @clean
 x  F1 a  W' 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  F3 b  R 𝗐𝗂𝗍𝗁 P @tag 𝒯𝒫'
  for R :: ('c::sep_monoid,'d) φ
  unfolding Action_Tag_def 𝗋Guard_def NO_SIMP_def φProd'_def
   premises A[unfolded equation31_cond_def, simp] and _ and _ and _ and _ and _
         and Tr[] and swap1 and C1[]
    apply_rule C1[THEN transformation_left_frame[where R=fst x  F1 a]]
    apply_rule 𝗋Comm_Mul.apply[OF swap1[where A=fst x  F1 a]]
    apply_rule apply_Module_Distr_HomoZ_LCond_φSome[where s=d and t=a and F=F1 and r=da and x=(xd, fst x) and C=Cd]
    apply_rule apply_Module_Distr_HomoZ_RCond_φSome[where s=da and t=c and F=F1 and x=(?jL Cd  (z d a) (xd, fst x), xc) and C=Cc]
    Tr
   .


subsection ‹ToA mapper over Semimodules›

context notes prod_opr_norm[simp] φProd_expn''[simp] comp_assoc[symmetric, simp]
begin

(* [--d--][-----a-----]
   [-----b-----][--c--]
   Give a, expect b; Need d, remain c.
   d, c ≠ 0; the scalar has to be non-commutative, otherwise reduces to either ‹SE_Module_SDistr_da_b_i› or ‹SE_Module_SDistr_a_cb_i›
   as we assume non-commutative scalar, the concrete algebra must be commutative*)

lemma SE_Module_SDistr_da_bc_ToA_mapper
      [φreason_template default %φmapToA_derived_module_SDistri
          name F1.module_mapperda_bc
          pass: phi_TA_Module_Distrib_rule_pass_no_comm_scalar]:
  ― ‹idk which one would be better. I perfer the former because,
      the getters are essentially identical, but the domain of the premises is simpler in the former›
  𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 a' = a  b' = b  c' = c
 NO_SIMP (𝗀𝗎𝖺𝗋𝖽 dabc_equation d a b c)
 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoS F1 Ds Dxu uz
 Type_Variant_of_the_Same_Scalar_Mul0 F1 F3
 Type_Variant_of_the_Same_Scalar_Mul0 F1 F1'
 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoZ F1 Ds Dxz z
 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoS F1' Ds' Dxu' uz'
 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoZ F1' Ds' Dxz' z'
 NO_MATCH (a''::'s'::partial_ab_semigroup_add) a @tag 𝒜_template_reason None

 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ds d  Ds a  Ds b  Ds c  Ds' b  Ds' c  Ds' d  Ds' a
― ‹TODO: module_mapper22 True d a b c uz' z' uz z Dx' Dxu' Dx Dxu DM fc fb fa fd

 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 ((xa,w,xd)D. let (y, yc) = uz b c (z d a (xd,xa))
                           in Dsz (xd,xa) (fb y, fc yc) 
                              Dxz d a (xd,xa) 
                              Dxu b c (z d a (xd,xa)) 
                              Dxz' b c (fb y, fc yc) 
                              Dxu' d a (z' b c (fb y, fc yc)) )

 𝗆𝖺𝗉 g f r : F3 b  R  F3' b  R'
    𝗈𝗏𝖾𝗋 fb f w : F1 b  W  F1' b  W'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s
      𝗂𝗇 (λ(xa,w,xd). case uz b c (z d a (xd,xa)) of (xb,xc)  (xb,w)) ` D

 separatable_module_zip True d a b c uz' z' uz z Dsz fb fc fd fa @tag 𝒜_template_reason undefined

 𝗆𝖺𝗉 g f (r f fc) : F3 b  R  F1 c  F3' b'  R'  F1' c'
    𝗈𝗏𝖾𝗋 fa f w f fd : F1 a  W  F1 d  F1' a'  W'  F1' d
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 SIMP (λ(xa,w,xd). let (xb,xc) = uz b c (z d a (xd,xa))
                                 ; (y,r) = h (xb,w)
                                in (y,r,xc))
         𝗌𝖾𝗍𝗍𝖾𝗋 SIMP (λ(y,r,xc). let (xb,w) = s (y,r)
                                 ; (xd,xa) = uz' d a (z' b c (xb,xc))
                                in (xa,w,xd))
      𝗂𝗇 D
  for F1 :: 's::partial_add_magma  ('c::sep_algebra, 'a) φ

  unfolding Action_Tag_def 𝗋Guard_def NO_SIMP_def Type_Variant_of_the_Same_Scalar_Mul0_def φProd'_def
  apply simp

   premises _ and A[THEN dabc_equation_D_main, simp] and _ and _ and _ and _ and _ and _ and Tr 
    apply_rule apply_Module_Distr_HomoZ[where t=a and s=d and F=F1 and x=case x of (xa,w,xd)  (xd,xa)]
    certified by (insert useful(1) useful(2)[THEN bspec[OF _ x  D]],
                  clarsimp split: prod.split simp add: useful(3-)) 
    apply_rule apply_Module_Distr_HomoS[where t=c and s=b and F=F1]
    certified by (insert useful(1) useful(2)[THEN bspec[OF _ x  D]],
                  clarsimp split: prod.split simp add: useful(3-))  ;;
    apply_rule ToA_Mapper_onward[OF Tr, where x=case x of (xa,w,xd)  case uz b c (z d a (xd,xa)) of (xb,xc)  (xb,w)]
      certified by (clarsimp split: prod.split simp add: φ image_iff, insert φ(4), force)
   certified by (clarsimp split: prod.split)
    apply(rule conjunctionI, rule)
   premises _ and A[THEN dabc_equation_D_main] and _ and _ and _ and _ and _ and _ and Tr
    note A[THEN conjunct1, symmetric, simp]
         A[THEN conjunct2, simp] 
    unfold b' = b
    unfold c' = c 
    apply_rule ToA_Mapper_backward[OF Tr, where x=case x of (y,r,xc)  (y,r)]
    certified by (insert useful(1), clarsimp split: prod.split simp add: φ image_iff,
                  case_tac uz b c (z d a (ba, aa)), clarsimp,
                  case_tac h (ac,aaa), clarsimp, force) 
    
    apply_rule apply_Module_Distr_HomoZ[where s=b and t=c and F=F1' and x=case x of (y,r,xc)  case s (y,r) of (xb,w)  (xb,xc)]
    certified apply (insert useful(1), simp add: image_iff del: split_paired_All, elim bexE)
              subgoal premises prems for y
                by (insert prems(2) useful(2)[THEN bspec[OF _ prems(1)]]
                             ToA_Mapper_f_expn[OF Tr, simplified, THEN bspec[OF _ prems(1)], symmetric],
                    clarsimp simp add: prod.rotL_def useful(3-) split: prod.split) . 

    apply_rule apply_Module_Distr_HomoS[where s=d and t=a and F=F1' and x=case x of (y,r,xc)  case s (y,r) of (xb,w)  z' b c (xb,xc)]
    certified apply (insert useful(1), simp add: image_iff del: split_paired_All, elim bexE)
              subgoal premises prems for y
                by (insert prems(2) useful(2)[THEN bspec[OF _ prems(1)]]
                             ToA_Mapper_f_expn[OF Tr, simplified, THEN bspec[OF _ prems(1)], symmetric],
                    clarsimp simp add: prod.rotL_def useful(3-) split: prod.split) . ;;
    fold a' = a
   certified by (clarsimp split: prod.split simp add: the_φ(16))
    apply (rule conjunctionI, rule, unfold Premise_def conj_imp_eq_imp_imp, rule ballI)
  subgoal premises prems for x proof -
    thm prems
      show ?thesis
        by (insert ToA_Mapper_f_expn_rev[OF 𝗆𝖺𝗉 g f r : _  _ 𝗈𝗏𝖾𝗋 fb f w : _  _ 𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s 𝗂𝗇 _,
                                     simplified, THEN bspec[OF _ x  D]]
                      separatable_module_zip _ _ _ _ _ _ _ _ _ _ _ _ _ _
                            [unfolded separatable_module_zip_def, THEN spec[where x=case x of (xa,w,xd)  (xd,xa)]],
            clarsimp split: prod.split simp: dabc_equation d a b c a' = a b' = b c' = c,
            insert prems(17) prems(20), fastforce)
    qed .



lemma SE_Module_SDistr_ad_cb_ToA_mapper
      [φreason_template default %φmapToA_derived_module_SDistri
          name F1.module_mapperad_cb
          pass: phi_TA_Module_Distrib_rule_pass_no_comm_scalar]:
  𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 a' = a  b' = b  c' = c
 NO_SIMP (𝗀𝗎𝖺𝗋𝖽 dabc_equation c b a d)
 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoS F1 Ds Dxu uz
 Type_Variant_of_the_Same_Scalar_Mul0 F1 F3
 Type_Variant_of_the_Same_Scalar_Mul0 F1 F1'
 Type_Variant_of_the_Same_Scalar_Mul0 F3 F3'
 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoZ F1 Ds Dxz z
 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoS F1' Ds' Dxu' uz'
 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoZ F1' Ds' Dxz' z'
 NO_MATCH (a''::'s'::partial_ab_semigroup_add) a @tag 𝒜_template_reason None

 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ds a  Ds d  Ds c  Ds b  Ds' c  Ds' b  Ds' a  Ds' d
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (xD. let (xa,w,xd) = x
                    ; (xc,xb) = uz c b (z a d (xa,xd))
                   in Dsz (xa,xd) (fc xc, f xb) 
                      Dxz a d (xa,xd) 
                      Dxu c b (z a d (xa,xd)) 
                      Dxz' c b (fc xc, f xb) 
                      Dxu' a d (z' c b (fc xc, f xb)) )

 𝗆𝖺𝗉 g f r : F3 b  R  F3' b  R'
    𝗈𝗏𝖾𝗋 f f w : F1 b  W  F1' b  W'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s
      𝗂𝗇 (λ(xa,w,xd). let (xc,xb) = uz c b (z a d (xa,xd)) in (xb,w)) ` D

 separatable_module_zip False a d c b uz' z' uz z Dsz fc f f' fd @tag 𝒜_template_reason undefined

 𝗆𝖺𝗉 g f (r f fc) : F3 b  R  F1 c  F3' b'  R'  F1' c'
    𝗈𝗏𝖾𝗋 f' f w f fd : F1 a  W  F1 d  F1' a'  W'  F1' d
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 SIMP (λ(xa,w,xd). let (xc,xb) = uz c b (z a d (xa,xd))
                                 ; (y,r) = h (xb,w)
                                in (y,r,xc))
         𝗌𝖾𝗍𝗍𝖾𝗋 SIMP (λ(y,r,xc). let (xb,w) = s (y,r)
                                 ; (xa,xd) = uz' a d (z' c b (xc,xb))
                                in (xa,w,xd))
      𝗂𝗇 D
  for F1 :: 's::partial_add_magma  ('c::sep_algebra, 'a) φ

  unfolding Action_Tag_def 𝗋Guard_def NO_SIMP_def SIMP_def
            Type_Variant_of_the_Same_Scalar_Mul0_def φProd'_def
  apply simp

   premises _ and dabc[THEN dabc_equation_D_main] and _ and _ and _ and _ and _ and _ and Tr and _ 
    note dabc[THEN conjunct1, symmetric, simp]
         dabc[THEN conjunct2, simp] 

    apply_rule apply_Module_Distr_HomoZ[where s=a and t=d and F=F1]
      certified by (instantiate (fst x, snd (snd x)), clarsimp split: prod.split simp add: useful, insert useful(1,2), force) ;;
    apply_rule apply_Module_Distr_HomoS[where t=b and s=c and F=F1]
    apply_rule ToA_Mapper_onward[OF Tr, where x=case x of (xa,w,xd)  case uz c b (z a d (xa,xd)) of (xc,xb)  (xb,w)]
      certified by (clarsimp split: prod.split simp add: useful)
   certified by (clarsimp split: prod.split simp add: useful)
    apply(rule conjunctionI, rule)
   premises _ and dabc[THEN dabc_equation_D_main, simp] and _ and _ and _ and _ and _ and _ and Tr
    unfold b' = b
    unfold c' = c
    apply_rule ToA_Mapper_backward[OF Tr, where x=case x of (y,r,xc)  (y,r)]
    certified apply (clarsimp simp add: image_iff useful split: prod.split,
                     insert useful(1), clarsimp simp add: image_iff split: prod.split)
              subgoal premises prems for x1 aa ba ab ac bb
                by (rule bexI[OF _ prems(2)], insert prems(1,3), clarsimp, case_tac h (x2, ac), clarsimp) . 

    apply_rule apply_Module_Distr_HomoZ[where s=c and t=b and F=F1' and x=case x of (y,r,xc)  case s (y,r) of (xb,w)  (xc,xb)]

    certified apply (insert useful(1)[simplified image_image], simp add: image_iff del: split_paired_All, elim bexE)
              subgoal premises prems for y
                by (insert prems(2) useful(2)[THEN bspec[OF _ prems(1)]]
                    ToA_Mapper_f_expn[OF Tr, simplified, THEN bspec[OF _ prems(1)], symmetric],
                    clarsimp simp add: useful(4-) split: prod.split) . 

    apply_rule apply_Module_Distr_HomoS[where s=a and t=d and F=F1' and x=case x of (y,r,xc)  case s (y,r) of (xb,w)  z' c b (xc,xb)]
    certified apply (insert useful(1)[simplified image_image], simp add: image_iff del: split_paired_All, elim bexE)
              subgoal premises prems for y
                by (insert prems(2) useful(2)[THEN bspec[OF _ prems(1)]]
                    ToA_Mapper_f_expn[OF Tr, simplified, THEN bspec[OF _ prems(1)], symmetric],
                    clarsimp simp add: useful(3-) split: prod.split) . ;;
    fold a' = a
   certified by (clarsimp split: prod.split simp add: the_φ(16))
    apply (rule conjunctionI, rule, unfold Premise_def conj_imp_eq_imp_imp, rule ballI)
    subgoal premises prems for x proof -

      show ?thesis
        by (insert ToA_Mapper_f_expn_rev[OF 𝗆𝖺𝗉 g f r : _  _ 𝗈𝗏𝖾𝗋 f f w : _  _ 𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s 𝗂𝗇 _,
                                     simplified, THEN bspec[OF _ x  D]]
                      separatable_module_zip _ _ _ _ _  _ _ _ _ _ _ _ _ _[unfolded separatable_module_zip_def, THEN spec[where x=case x of (xa,w,xd)  (xa,xd)]],
            clarsimp split: prod.split simp: dabc_equation c b a d a' = a b' = b c' = c,
            insert prems(17) prems(20), fastforce)
    qed .



lemma SE_Module_SDistr_a_dbc_ToA_mapper
      [φreason_template default %φmapToA_derived_module_SDistri
        name: F1.module_mappera_dbc
        pass: phi_TA_Module_Distrib_rule_pass_no_comm_scalar]:
  𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 a' = a  b' = b
 NO_SIMP (𝗀𝗎𝖺𝗋𝖽 equation31_cond Cd Cc d b db c a)
 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoS F1 Ds Dx uz
 Type_Variant_of_the_Same_Scalar_Mul0 F1 F3
 Type_Variant_of_the_Same_Scalar_Mul0 F1 F1'
 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoZ F1' Ds' Dxz z

 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (Cc  Ds c  Ds db  Ds' db  Ds' c) 
                  (Cd  Ds d  Ds b  Ds' d  Ds' b )
 NO_SIMP (module_mapper31C Cc Cd c b db d uz z Dx Dxz DG fc f fd f' getter)

 𝗆𝖺𝗉 g f r : F3 b  RG  F3' b  RG'
    𝗈𝗏𝖾𝗋 f f w : F1 b  W   F1' b  W'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s
      𝗂𝗇 (λ(x,w). case getter x of (xd, xb, xc)  (xb, w)) ` D

 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (xD. DG (fst x))

 𝗆𝖺𝗉 g f r f fd f fc : F3 b  RG  ◒[Cd] F1 d  ◒[Cc] F1 c  F3' b'  RG'  ◒[Cd] F1' d  ◒[Cc] F1' c
    𝗈𝗏𝖾𝗋 f' f w : F1 a  W  F1' a'  W'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 SIMP (λ(x,w). let (xd, xb, xc) = getter x
                              ; (y,r) = h (xb, w)
                             in (y, r, xd, xc))
         𝗌𝖾𝗍𝗍𝖾𝗋 SIMP (λ(y,r,xd,xc). case s (y,r) of (xb,w) 
                        (?jR Cc (z db c) (?jL Cd (z d b) (xd,xb), xc), w))
      𝗂𝗇 D
  for F1 :: 's::partial_add_magma  ('c::sep_algebra, 'a) φ

  unfolding Action_Tag_def 𝗋Guard_def NO_SIMP_def module_mapper31C_def
            Type_Variant_of_the_Same_Scalar_Mul0_def φProd'_def
  apply simp

   premises _ and EC[unfolded equation31_cond_def, simplified, simp] and SS[] and SZ[] and _
         and MG and Tr[] and DG and Dom[useful]
    note DG' = DG[THEN bspec[OF _ Dom]]
    note t1[useful] = MG[THEN spec, THEN mp, OF DG'] 

    apply_rule apply_Module_Distr_HomoS_RCond[OF SS, where s=db and t=c and C=Cc]
    apply_rule apply_Module_Distr_HomoS_LCond[OF SS, where s=d and t=b and C=Cd]

    apply_rule ToA_Mapper_onward[OF Tr,
        where x=case x of (x,w)  case ?sR Cc (uz db c) x of (xdb, xc)  case ?sL Cd (uz d b) xdb of (xd, xb)  (xb, w)]
      certified by (insert t1, clarsimp split: prod.split simp: image_iff, metis Dom fst_conv snd_conv)
      
   certified by (insert t1, clarsimp simp add: image_iff split: prod.split)
    apply (rule conjunctionI, rule)
   premises _ and EC[unfolded equation31_cond_def, simplified, simp] and SS[] and SZ[] and _
         and MG and Tr[] and DG and Dom'
    from Dom'
    obtain y where Dom[useful]: y  D
               and x_def[simp]: x = (g f r f fd f fc) (case y of (x, w) 
                                              case getter x of (xd, xb, xc)  case h (xb, w) of (y, r)  (y, r, xd, xc))
      by (clarsimp simp add: split_beta)
    note DG' = DG[THEN bspec[OF _ Dom]]
    note t1[useful] = MG[THEN spec, THEN mp, OF DG', THEN mp, OF EC[THEN conjunct2]] ;;

    unfold b' = b
    apply_rule ToA_Mapper_backward[OF Tr, where x=apsnd fst x]
    certified by (insert t1 Dom, clarsimp simp add: image_iff split: prod.split, force)  

    apply_rule apply_Module_Distr_HomoZ_LCond_φSome[OF SZ, where s=d and t=b and r=db and C=Cd
                                                                and x=case x of (y,r,xd,xc)  case s (y,r) of (xb,w)  (xd,xb)]
    certified by (insert useful(1) the_φ(6) ToA_Mapper_f_expn_rev[OF Tr],
                  clarsimp simp add: image_iff Cd  _  _ split: prod.split,
                  fastforce) 

    apply_rule apply_Module_Distr_HomoZ_RCond_φSome[OF SZ, where s=db and t=c and r=a and C=Cc
                                                             and x=case x of (y,r,xd,xc)  case s (y,r) of (xb,w)  (?jL Cd (z d b) (xd,xb), xc)]
    certified by (insert t1 Dom ToA_Mapper_f_expn_rev[OF Tr, simplified, THEN bspec[OF _ Dom]],
          clarsimp simp add: image_iff split: prod.split, auto_sledgehammer) ;;
    fold a' = a
   certified by (clarsimp split: prod.split)
    apply (rule conjunctionI, rule, unfold Premise_def conj_imp_eq_imp_imp, rule ballI)
    subgoal premises prems for x proof -

      show ?thesis
        by (insert ToA_Mapper_f_expn_rev[OF 𝗆𝖺𝗉 g f r : _  _ 𝗈𝗏𝖾𝗋 f f w : _  _ 𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s 𝗂𝗇 _,
                                            simplified, THEN bspec[OF _ x  D]]
                      x. DG x  _ [THEN spec[where x=fst x]],
            clarsimp split: prod.split, auto_sledgehammer)
    qed .



lemma SE_Module_SDistr_a_dεc_ToA_mapper
      [φreason_template default %φmapToA_derived_module_SDistri
        name: F1.module_mappera_dεc
        pass: phi_TA_Module_Distrib_rule_pass_no_comm_scalar]:
  𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 a' = a
 NO_SIMP (𝗀𝗎𝖺𝗋𝖽 equation31_cond Cd Cc d ε  c a )
 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoS F1 Ds Dx uz
 Type_Variant_of_the_Same_Scalar_Mul0 F1 F3
 Type_Variant_of_the_Same_Scalar_Mul0 F1 F1'
 Type_Variant_of_the_Same_Scalar_Mul0 F1 F3'
 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoZ F1' Ds' Dxz z
 𝗀𝗎𝖺𝗋𝖽 Module_OneE F1 U ε DεE Eε Any_PE
 TERM Module_OneI F3 T ε DεIT IεT Any_PIT
 𝗀𝗎𝖺𝗋𝖽 Module_OneI F1' U' ε DεI Iε Any_PI
 TERM Module_OneE F3' T' ε DεET EεT Any_PET
 NO_MATCH (a''::'s'::partial_ab_semigroup_add) a @tag 𝒜_template_reason None

 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (Cc  Ds c  Ds   Ds'   Ds' c) 
                  (Cd  Ds d  Ds ε  Ds' d  Ds' ε)
 NO_SIMP (module_mapper3εC Cc Cd c ε  d uz z Eε Iε DεE DεI Dx Dxz DG fc f fd f' getter)

 𝗆𝖺𝗉 g f r : T  RG  T'  RG'
    𝗈𝗏𝖾𝗋 f f w : U  W  U'  W'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s
      𝗂𝗇 (λ(x,w). case getter x of (xd, xb, xc)  (xb, w)) ` D

 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (xD. DG (fst x))

 𝗆𝖺𝗉 g f r f fd f fc : T  RG  ◒[Cd] F1 d  ◒[Cc] F1 c  T'  RG'  ◒[Cd] F1' d  ◒[Cc] F1' c
    𝗈𝗏𝖾𝗋 f' f w : F1 a  W  F1' a'  W'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 SIMP (λ(x,w). let (xd, xb, xc) = getter x
                              ; (y,r) = h (xb, w)
                             in (y, r, xd, xc))
         𝗌𝖾𝗍𝗍𝖾𝗋 SIMP (λ(y,r,xd,xc). case s (y,r) of (xb,w) 
                        (?jR Cc (z  c) (?jL Cd (z d ε) (xd, Iε xb), xc), w))
      𝗂𝗇 D
  for F1 :: 's::partial_add_magma  ('c::sep_algebra, 'a) φ

  unfolding Action_Tag_def 𝗋Guard_def NO_SIMP_def φProd'_def
            Type_Variant_of_the_Same_Scalar_Mul0_def module_mapper3εC_def
  apply simp

   premises _ and EC[unfolded equation31_cond_def, simp] and SS[] and SZ[] and S1E[] and [] and S1I[] and [] and _
         and MG and Tr[] and DG[] and Dom[useful]
    note DG' = DG[THEN bspec[OF _ Dom]]
    from EC have db: ?+ True  = ?+ Cd d + ?+ True ε  (Cc   ##+ c)  (Cd  d ##+ ε) by blast
    note t1[useful] = MG[THEN spec, THEN mp, OF DG', THEN mp, OF db] 

    apply_rule apply_Module_Distr_HomoS_RCond[OF SS, where s= and t=c and C=Cc]
    
    apply_rule apply_Module_Distr_HomoS_LCond[OF SS, where s=d and t=ε and C=Cd]

    apply_rule apply_Module_OneE[OF S1E] 

    apply_rule ToA_Mapper_onward[OF Tr,
        where x=case x of (x,w)  case getter x of (xd, xb, xc)  (xb, w)]
      certified by (insert t1 Dom, clarsimp split: prod.split simp: image_iff Let_def, auto_sledgehammer)

   certified by (insert t1 Dom, clarsimp split: prod.split simp: image_iff Let_def, auto_sledgehammer)
    apply (rule conjunctionI, rule)
   premises _ and EC[unfolded equation31_cond_def, simp] and SS[] and SZ[] and S1E[] and [] and S1I[] and [] and _
         and MG and Tr[] and DG[]  and Dom'[]
    from Dom'
    obtain y where Dom[useful]: y  D
               and x_def[simp]: x = (g f r f fd f fc) (
                        case y of (x, w)  case getter x of (xd, xb, xc)  case h (xb, w) of (y, r)  (y, r, xd, xc))
      by (clarsimp simp add: split_beta)

    note DG' = DG[THEN bspec[OF _ Dom]]
    from EC have db: ?+ True  = ?+ Cd d + ?+ True ε  (Cc   ##+ c)  (Cd  d ##+ ε) by blast
    note t1[useful] = MG[THEN spec, THEN mp, OF DG', THEN mp, OF db] ;;

    apply_rule ToA_Mapper_backward[OF Tr, where x=apsnd fst x]
    certified by (insert t1 Dom, clarsimp simp add: image_iff split: prod.split, force) ;;

    apply_rule apply_Module_OneI[OF S1I]
    certified by (insert t1 Dom ToA_Mapper_f_expn_rev[OF Tr, simplified Ball_image_comp, THEN bspec[OF _ Dom]],
                  clarsimp simp add: image_iff split: prod.split) ;;

    apply_rule apply_Module_Distr_HomoZ_LCond_φSome[OF SZ, where s=d and t=ε and r= and C=Cd
                                                                and x=case x of (y,r,xd,xc)  case s (y,r) of (xb,w)  (xd, Iε xb)]
    certified by (insert t1 Dom ToA_Mapper_f_expn_rev[OF Tr, simplified Ball_image_comp, THEN bspec[OF _ Dom]],
                  clarsimp simp add: image_iff split: prod.split, auto_sledgehammer) ;;

    apply_rule apply_Module_Distr_HomoZ_RCond_φSome[OF SZ, where s= and t=c and r=a and C=Cc
                                                             and x=case x of (y,r,xd,xc)  case s (y,r) of (xb,w)  (?jL Cd (z d ε) (xd,Iε xb), xc)]
    certified by (insert t1 Dom ToA_Mapper_f_expn_rev[OF Tr, simplified Ball_image_comp, THEN bspec[OF _ Dom]],
                  clarsimp simp add: image_iff split: prod.split, auto_sledgehammer) ;;
    fold a' = a
   certified by (clarsimp split: prod.split)
    apply (rule conjunctionI, rule, unfold Premise_def conj_imp_eq_imp_imp, rule ballI)
    subgoal premises prems for x proof -
        show ?thesis
          by (insert ToA_Mapper_f_expn_rev[OF 𝗆𝖺𝗉 g f r : _  _ 𝗈𝗏𝖾𝗋 f f w : _  _ 𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s 𝗂𝗇 _,
                                              simplified, THEN bspec[OF _ x  D]]
                     x. DG x  _ [THEN spec[where x=fst x]],
              clarsimp split: prod.split, auto_sledgehammer)
      qed .

(* NOT MAINTAINED BUT DO NOT REMOVE, I am still not sure whether we can leave from conditioned
   split at all.
lemma SE_Module_SDistr_a_dεc_ToA_mapper
      [φreason_template default %φmapToA_derived_module_SDistri
        name: F1.module_mappera_dεc
        pass: phi_TA_Module_Distrib_rule_pass_no_comm_scalar]:
  ‹ NO_SIMP (𝗀𝗎𝖺𝗋𝖽 a = d + ε + c @tag 𝒜arith_eq)
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoS F1 Ds Dx uz
⟹ Type_Variant_of_the_Same_Scalar_Mul0 F1 F3
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoZ F1 Ds' Dxz z
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_OneE F1 U ε DεE Eε Any_PE
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_OneI F1 U' ε DεI Iε Any_PI
⟹ NO_MATCH (a'::'s'::partial_ab_semigroup_add) a @tag 𝒜_template_reason None

⟹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ds c ∧ Ds (d + ε) ∧ d + ε ##+ c ∧ Ds' (d + ε) ∧ Ds' c ∧
                  Ds d ∧ Ds ε ∧ Ds' d ∧ Ds' ε ∧ d ##+ ε
⟹ module_mapper3ε c ε d uz z Eε Iε DεE DεI Dx Dxz DG fc f fd f' getter @tag 𝒜_template_reason undefined

⟹ 𝗆𝖺𝗉 g ⊗f r : T ∗[CRG] RG ↦ T' ∗[CRG] RG'
    𝗈𝗏𝖾𝗋 f ⊗f w : U ∗[CW] W ↦ U' ∗[CW] W'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s
      𝗂𝗇 (λ(x,w). case getter x of (xc, xb, xd) ⇒ (xb, w)) ` D

⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀x∈D. Dsm (fst x) ∧ DG (fst x))

⟹ ◒[CR] R  = ◒[CRG] RG  ∗ ◒[True] F1 d ∗ ◒[True] F1 c @tag 𝒜merge
⟹ ◒[CR] R' = ◒[CRG] RG' ∗ ◒[True] F1 d ∗ ◒[True] F1 c @tag 𝒜merge

⟹ 𝗆𝖺𝗉 g ⊗f r ⊗f fdf fc : T ∗[CR] R ↦ T' ∗[CR] R'
    𝗈𝗏𝖾𝗋 f' ⊗f w : F1 a ∗[CW] W ↦ F1 a ∗[CW] W'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 SIMP (λ(x,w). let (xc, xb, xd) = getter x
                              ; (y,r) = h (xb, w)
                             in (y, r, xd, xc))
         𝗌𝖾𝗍𝗍𝖾𝗋 SIMP (λ(y,r,xd,xc). case s (y,r) of (xb,w) ⇒ (z c (d + ε) (xc, z ε d (Iε xb, xd)), w))
      𝗂𝗇 D ›
  for F1 :: ‹'s::partial_add_magma ⇒ ('c::sep_ab_semigroup, 'a) φ›

  unfolding Action_Tag_def 𝗋Guard_def NO_SIMP_def
            Type_Variant_of_the_Same_Scalar_Mul0_def module_mapper3ε_def
  apply (simp add: ToA_Mapper_φSome_rewr_origin;
         simp add: φProd_expn'' φProd_expn' φSome_φProd[symmetric] Cond_φProd_expn_φSome)

  ❴ premises [simp] and SS[] and SZ[] and S1E[] and S1I[] and _ and A and Tr[] and _ and [] and []

    apply_rule apply_Module_Distr_HomoS_φSome[OF SS, where s=‹d+ε› and t=c]
    certified by (insert useful(1) useful(2)[THEN bspec[OF _ useful(1)]]
                         A[THEN spec[where x=‹fst x›]],
                    clarsimp split: prod.split simp: useful(3-) Let_def) ;;
    
    apply_rule apply_Module_Distr_HomoS_φSome[OF SS, where s=‹d› and t=ε]
    certified by (insert useful(1) useful(2)[THEN bspec[OF _ useful(1)]]
                         A[THEN spec[where x=‹fst x›]],
                    clarsimp split: prod.split simp: useful(3-) Let_def) ;;

    apply_rule apply_Module_OneE_φSome[OF S1E]
    certified by (insert useful(1) useful(2)[THEN bspec[OF _ useful(1)]]
                         A[THEN spec[where x=‹fst x›]],
                    clarsimp split: prod.split simp: useful(3-) Let_def) ;;

    apply_rule ToA_Mapper_onward[OF Tr,
        where x=‹case x of (x,w) ⇒ case getter x of (xc, xb, xd) ⇒ (xb, w)›]
      certified by (insert A[THEN spec[where x=‹fst x›]]
                           useful(2) useful(3)[THEN bspec[OF _ useful(2)]],
                    clarsimp split: prod.split simp: image_iff Let_def, metis prod.inject)
  
  ❵ certified by (insert A[THEN spec[where x=‹fst x›]]
                         useful(3)[THEN bspec[OF _ ‹x ∈ D›]],
                  clarsimp simp add: image_iff Let_def split: prod.split)
    apply (rule conjunctionI, rule)
  ❴ premises _ and SS[] and SZ[] and S1E[] and S1I[] and _ and A and Tr[] and _ and [] and []

    apply_rule ToA_Mapper_backward[OF Tr, where x=‹apsnd fst x›]
    certified apply (insert useful(1), clarsimp simp add: image_iff split: prod.split)
    subgoal premises prems for a b
      by (insert useful(2)[THEN bspec[OF _ ‹_ ∈ D›]]
                 A[THEN spec[where x=‹a›]] prems,
          clarsimp simp: Let_def split: prod.split, force) . ;;

    apply_rule apply_Module_OneI_φSome[OF S1I]
    certified apply (insert useful(1), clarsimp simp add: image_iff split: prod.split)
              subgoal premises prems for a b
                by (insert prems useful(2)[THEN bspec[OF _ prems(1)]]
                           ToA_Mapper_f_expn_rev[OF Tr, simplified Ball_image_comp, THEN bspec[OF _ prems(1)]]
                           A[THEN spec[where x=‹a›]],
                    clarsimp simp: Let_def) . ;;

    apply_rule apply_Module_Distr_HomoZ_φSome[OF SZ, where s=‹d› and t=ε
                                                                and x=‹case x of (y,r,xd,xc) ⇒ case s (y,r) of (xb,w) ⇒ (Iε xb,xd)›]
    certified apply (insert useful(2), clarsimp simp add: image_iff split: prod.split)
              subgoal premises prems for a b
                by (insert useful(3)[THEN bspec[OF _ prems(1)]]
                           ToA_Mapper_f_expn_rev[OF Tr, simplified Ball_image_comp, THEN bspec[OF _ prems(1)]]
                           A[THEN spec[where x=‹a›]],
                    insert prems, clarsimp simp: Let_def useful(4-), case_tac ‹h (Eε xaa, b)›, clarsimp) . ;;

    apply_rule apply_Module_Distr_HomoZ_φSome[OF SZ, where s=‹d+ε› and t=c
                                                            and x=‹case x of (y,r,xd,xc) ⇒ case s (y,r) of (xb,w) ⇒ (xc, z ε d (Iε xb,xd))›]
    certified apply (insert useful(2), clarsimp)
              subgoal premises prems for xa aa aaa ba ab bb
                by (insert prems ToA_Mapper_f_expn_rev[OF Tr, simplified, THEN bspec[OF _ ‹(ab, bb) ∈ D›]]
                           useful(3)[THEN bspec[OF _ ‹(ab, bb) ∈ D›]]
                           A[THEN spec[where x=‹ab›]],
                    clarsimp simp add: image_iff useful(4-) split: prod.split,
                    case_tac ‹h (Eε xaa, bb)›, clarsimp) .

  ❵ certified by (clarsimp split: prod.split)
    apply (rule conjunctionI, rule, unfold Premise_def conj_imp_eq_imp_imp, rule ballI)
    subgoal premises prems for x proof -
      show ?thesis
        by (insert ToA_Mapper_f_expn_rev[OF ‹𝗆𝖺𝗉 g ⊗f r : _ ↦ _ 𝗈𝗏𝖾𝗋 f ⊗f w : _ ↦ _ 𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s 𝗂𝗇 _›,
                                            simplified, THEN bspec[OF _ ‹x ∈ D›]]
                      ‹∀x. DG x ⟶ _› [THEN spec[where x=‹fst x›]],
            clarsimp split: prod.split, auto_sledgehammer)
    qed .


lemma SE_Module_SDistr_a_εc_ToA_mapper
      [φreason_template default %φmapToA_derived_module_SDistri
        name: F1.module_mappera_εc
        pass: phi_TA_Module_Distrib_rule_pass_no_comm_scalar]:
  ‹ NO_SIMP (𝗀𝗎𝖺𝗋𝖽 a = ε + c @tag 𝒜arith_eq)
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoS F1 Ds Dx uz
⟹ Type_Variant_of_the_Same_Scalar_Mul0 F1 F3
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoZ F1 Ds' Dxz z
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_OneE F1 U ε DεE Eε Any_PE
⟹ 𝗀𝗎𝖺𝗋𝖽 Module_OneI F1 U' ε DεI Iε Any_PI
⟹ NO_MATCH (a'::'s'::partial_ab_semigroup_add) a @tag 𝒜_template_reason None

⟹ 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ds c ∧ Ds ε ∧ ε ##+ c ∧ Ds' ε ∧ Ds' c
⟹ module_mapper2εR c ε uz z Eε Iε DεE DεI Dx Dxz DG fc f f' getter @tag 𝒜_template_reason None

⟹ 𝗆𝖺𝗉 g ⊗f r : T ∗[CRG] RG ↦ T' ∗[CRG] RG'
    𝗈𝗏𝖾𝗋 f ⊗f w : U ∗[CW] W ↦ U' ∗[CW] W'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s
      𝗂𝗇 (λ(x,w). case getter x of (xc, xb) ⇒ (xb, w)) ` D

⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (∀x∈D. Dsm (fst x) ∧ DG (fst x))

⟹ ◒[CR] R  = ◒[CRG] RG  ∗ ◒[True] F1 c @tag 𝒜merge
⟹ ◒[CR] R' = ◒[CRG] RG' ∗ ◒[True] F1 c @tag 𝒜merge

⟹ 𝗆𝖺𝗉 g ⊗f r ⊗f fc : T ∗[CR] R ↦ T' ∗[CR] R'
    𝗈𝗏𝖾𝗋 f' ⊗f w : F1 a ∗[CW] W ↦ F1 a ∗[CW] W'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 SIMP (λ(x,w). let (xc, xb) = getter x
                              ; (y,r) = h (xb, w)
                             in (y, r, xc))
         𝗌𝖾𝗍𝗍𝖾𝗋 SIMP (λ(y,r,xc). case s (y,r) of (xb,w) ⇒ (z c ε (xc, Iε xb), w))
      𝗂𝗇 D ›
  for F1 :: ‹'s::partial_add_magma ⇒ ('c::sep_ab_semigroup, 'a) φ›

  unfolding Action_Tag_def 𝗋Guard_def NO_SIMP_def
            Type_Variant_of_the_Same_Scalar_Mul0_def module_mapper2εR_def
  apply (simp add: ToA_Mapper_φSome_rewr_origin;
         simp add: φProd_expn'' φProd_expn' φSome_φProd[symmetric] Cond_φProd_expn_φSome)

  ❴ premises _ and SS[] and SZ[] and S1E[] and S1I[]and _ and A  and Tr[] and _ and [] and []

    apply_rule apply_Module_Distr_HomoS_φSome[OF SS, where s=‹ε› and t=c]
    certified by (insert useful(1) useful(2)[THEN bspec[OF _ useful(1)]]
                         A[THEN spec[where x=‹fst x›]],
                    clarsimp split: prod.split simp: useful(3-) Let_def) ;;

    apply_rule apply_Module_OneE_φSome[OF S1E]
    certified by (insert useful(1) useful(2)[THEN bspec[OF _ useful(1)]]
                         A[THEN spec[where x=‹fst x›]],
                    clarsimp split: prod.split simp: useful(3-) Let_def) ;;

    apply_rule ToA_Mapper_onward[OF Tr,
        where x=‹case x of (x,w) ⇒ case getter x of (xc, xb) ⇒ (xb, w)›]
      certified by (insert A[THEN spec[where x=‹fst x›]]
                           useful(2) useful(3)[THEN bspec[OF _ useful(2)]]
                           A[THEN spec[where x=‹fst x›]],
                    clarsimp split: prod.split simp: image_iff Let_def,
                    metis Pair_inject)
  ❵ certified by (insert A[THEN spec[where x=‹fst x›]]
                         useful(3)[THEN bspec[OF _ ‹x ∈ D›]],
                  clarsimp simp add: image_iff Let_def split: prod.split)
    apply (rule conjunctionI, rule)
  ❴ premises _ and SS[] and SZ[] and S1E[] and S1I[] and _ and A and Tr[] and _ and [] and []

    apply_rule ToA_Mapper_backward[OF Tr, where x=‹apsnd fst x›]
    certified apply (insert useful(1), clarsimp simp add: image_iff split: prod.split)
    subgoal premises prems for a b
      by (insert useful(2)[THEN bspec[OF _ ‹_ ∈ D›]]
                 A[THEN spec[where x=‹a›]]
                 prems,
          clarsimp simp: Let_def split: prod.split, force) . ;;

    apply_rule apply_Module_OneI_φSome[OF S1I]
    certified apply (insert useful(1), clarsimp simp add: image_iff split: prod.split)
              subgoal premises prems for a b
                by (insert prems useful(2)[THEN bspec[OF _ prems(1)]]
                           ToA_Mapper_f_expn_rev[OF Tr, simplified Ball_image_comp, THEN bspec[OF _ prems(1)]]
                           A[THEN spec[where x=‹a›]],
                    clarsimp simp: Let_def) . ;;

    apply_rule apply_Module_Distr_HomoZ_φSome[OF SZ, where s=‹ε› and t=c
                                                            and x=‹case x of (y,r,xc) ⇒ case s (y,r) of (xb,w) ⇒ (xc, Iε xb)›]
    certified apply (insert useful(2), clarsimp)
              subgoal premises prems for xa a b aa ba
                by (insert prems ToA_Mapper_f_expn_rev[OF Tr, simplified, THEN bspec[OF _ ‹(aa, ba) ∈ D›]]
                           useful(3)[THEN bspec[OF _ ‹(aa, ba) ∈ D›]]
                           A[THEN spec[where x=‹aa›]],
                    clarsimp simp add: image_iff useful(4-) split: prod.split,
                    case_tac ‹h (Eε y, ba)›, clarsimp) .

  ❵ certified by (clarsimp split: prod.split)
    apply (rule conjunctionI, rule, unfold Premise_def conj_imp_eq_imp_imp, rule ballI)
    subgoal premises prems for x proof -
      show ?thesis
        by (insert ToA_Mapper_f_expn_rev[OF ‹𝗆𝖺𝗉 g ⊗f r : _ ↦ _ 𝗈𝗏𝖾𝗋 f ⊗f w : _ ↦ _ 𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s 𝗂𝗇 _›,
                                            simplified, THEN bspec[OF _ ‹x ∈ D›]]
                   ‹∀x. DG x ⟶ _› [THEN spec[where x=‹fst x›]],
            clarsimp split: prod.split, auto_sledgehammer)
    qed .
*)


lemma SE_Module_SDistr_dac_b_ToA_mapper
      [φreason_template default %φmapToA_derived_module_SDistri name: F1.module_mapperdac_b]:
  𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 a' = a  b' = b
 NO_SIMP (𝗀𝗎𝖺𝗋𝖽 equation31_cond Cd Cc d a da c b)
 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoZ F1 Ds Dx z
 Type_Variant_of_the_Same_Scalar_Mul0 F1 F3
 Type_Variant_of_the_Same_Scalar_Mul0 F1 F1'
 𝗀𝗎𝖺𝗋𝖽 Module_Distr_HomoS F1' Ds' DxS uz
 NO_MATCH (a''::'s'::partial_ab_semigroup_add) a @tag 𝒜_template_reason None

 𝗀𝗎𝖺𝗋𝖽 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (Cd  Ds d  Ds a  Ds' d  Ds' a) 
                  (Cc  Ds da  Ds c  Ds' da  Ds' c)
 module_mapper13C Cc Cd d a da c uz z DxS Dx DG fd fa fc f getter

 𝗆𝖺𝗉 g f r : F3 b  R   F3' b  R'
    𝗈𝗏𝖾𝗋 f f w : F1 b  WG  F1' b  WG'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s
      𝗂𝗇 (λ(xa,xd,xc,w). (getter (xa,xd,xc), w)) ` D

 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 ((xa,xd,xc,w)D. DG (xa,xd,xc))

 𝗆𝖺𝗉 g f r : F3 b  R  F3' b'  R'
    𝗈𝗏𝖾𝗋 fa f fd f fc f w : F1 a'  ◒[Cd] F1 d  ◒[Cc] F1  c  WG  F1' a'  ◒[Cd] F1' d  ◒[Cc] F1' c  WG'
    𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 SIMP (λ(xa,xd,xc,w). h (getter (xa,xd,xc), w))
         𝗌𝖾𝗍𝗍𝖾𝗋 SIMP (λyr. let (xb,w) = s yr
                           ; (xda,xc) = ?sR Cc (uz da c) xb
                           ; (xd,xa) = ?sL Cd (uz d a) xda
                          in (xa,xd,xc,w))
      𝗂𝗇 D
  for F1 :: 's::partial_add_magma  ('c::sep_algebra, 'a) φ
  unfolding Action_Tag_def 𝗋Guard_def NO_SIMP_def Type_Variant_of_the_Same_Scalar_Mul0_def φProd'_def
  apply simp

   premises [simp] and EC[unfolded equation31_cond_def, simp] and SZ[] and [] and [simp]
         and MG and Tr[] and DG[] and Dom
    from DG[THEN bspec[OF _ Dom]]
    have DG': DG (case x of (xa, xd, xc, w)  (xa, xd, xc)) by (cases x; clarsimp)
    note t1[useful] = MG[unfolded module_mapper13C_def, THEN spec, THEN mp, OF DG', THEN mp, OF EC[THEN conjunct2]] ;;

    apply_rule apply_Module_Distr_HomoZ_LCond_φSome[OF SZ, where s=d and t=a and r=da and C=Cd
                                                                  and x=case x of (xa,xd,xc,w)  (xd,xa)]
    certified by (insert t1 Dom, clarsimp split: prod.split) ;;
      
    apply_rule apply_Module_Distr_HomoZ_RCond_φSome[OF SZ, where s=da and t=c and r=b and C=Cc
                                                                  and x=case x of (xa,xd,xc,w)  (?jL Cd (z d a) (xd,xa), xc)]
    certified by (insert t1 Dom, clarsimp split: prod.split) ;;

    apply_rule ToA_Mapper_onward[OF Tr, where x=case x of (xa,xd,xc,w)  (?jR Cc (z da c) (?jL Cd (z d a) (xd,xa), xc), w)]
    certified by (insert t1 Dom, clarsimp split: prod.split simp: image_iff, auto_sledgehammer)
   certified by (insert t1 Dom, clarsimp split: prod.split simp: image_iff)
    apply (rule conjunctionI, rule)
   premises _ and EC[unfolded equation31_cond_def, simp] and SZ[] and SS[] and B
         and MG and Tr[] and DG[] and Dom'[]

    from Dom'
    obtain y where Dom[useful]: y  D
               and x_def[simp]: x = (g f r) (case y of (xa, xd, xc, w)  h (getter (xa, xd, xc), w))
      by (clarsimp, metis map_prod_simp)

    from DG[THEN bspec[OF _ Dom]]
    have DG': DG (case y of (xa, xd, xc, w)  (xa, xd, xc)) by (cases x; clarsimp)
    note t1[useful] = MG[unfolded module_mapper13C_def, THEN spec, THEN mp, OF DG', THEN mp, OF EC[THEN conjunct2]] ;;

    unfold b' = b
    apply_rule ToA_Mapper_backward[OF Tr, where x=x]
    certified by (insert t1 Dom, clarsimp split: prod.split simp: image_iff, force) 

    apply_rule apply_Module_Distr_HomoS_RCond[OF SS, where x=(fst o s) x and s=da and t=c and r=b and C=Cc]
    certified by (insert t1 Dom ToA_Mapper_f_expn_rev[OF Tr, simplified Ball_image_comp, THEN bspec[OF _ Dom]],
                  clarsimp split: prod.split simp: image_iff B) 

    apply_rule apply_Module_Distr_HomoS_LCond[OF SS, where s=d and t=a and r=da and C=Cd and x=(fst o ?sR Cc (uz da c) o fst o s) x]
    certified by (insert t1 Dom ToA_Mapper_f_expn_rev[OF Tr, simplified Ball_image_comp, THEN bspec[OF _ Dom]],
                 clarsimp split: prod.split simp: image_iff B) ;;
    fold a' = a
   certified by (clarsimp split: prod.split simp: prod.map_beta the_φ(10))
    apply (rule conjunctionI, rule, rule, unfold Premise_def conj_imp_eq_imp_imp module_mapper13C_def)
  subgoal premises prems for x proof -
    from (xa, xd, xc, w)D. DG (xa, xd, xc)[THEN bspec[OF _ x  D]]
    have DG': DG (case x of (xa, xd, xc, w)  (xa, xd, xc)) by (cases x; clarsimp)

    show ?thesis
      by (insert ToA_Mapper_f_expn_rev[OF 𝗆𝖺𝗉 g f r : _  _ 𝗈𝗏𝖾𝗋 f f w : _  _ 𝗐𝗂𝗍𝗁 𝗀𝖾𝗍𝗍𝖾𝗋 h 𝗌𝖾𝗍𝗍𝖾𝗋 s 𝗂𝗇 _,
                                          simplified, THEN bspec[OF _ x  D]]
                 x. DG x  _[THEN spec, THEN mp, OF DG'],
          cases x, clarsimp split: prod.split,
          case_tac ?sR Cc (uz da c) (f (?jR Cc (z da c) (?jL Cd (z d a) (b, aa), ca))), clarsimp,
          case_tac ?sL Cd (uz d a) x1, clarsimp,
          insert equation31_cond_def prems(3), fastforce)
  qed .

end



subsection ‹Commutativity between φ-Type Operators›

paragraph ‹Deriving Rewrites›

(*TODO Tyops_Commute1_2*)

subparagraph ‹1-to-1›

lemma Comm_Tyops_Rewr_temlpate[φreason_template name F.G.rewr[]]:
  Tyops_Commute F F' G G' T D (embedded_func f P)
 Tyops_Commute G' G F' F T D' (embedded_func g Q)
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (g (f x) = x)  D x  D' (f x)
 (x  F (G T)) = (f x  G' (F' T))
  unfolding Tyops_Commute_def Premise_def Transformation_def BI_eq_iff
  by clarsimp metis

lemma Comm_Tyops_Rewr2_temlpate[φreason_template name F.G.rewr[]]:
  Tyops_Commute1_2 F F'T F'U G G' T U D (embedded_func f P)
 Tyops_Commute2_1 F F'T F'U G G' T U D' (embedded_func g Q)
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 g (f x) = x  D x  D' (f x)
 (x  F (G T U)) = (f x  G' (F'T T) (F'U U))
  unfolding BI_eq_iff Premise_def Tyops_Commute1_2_def Tyops_Commute2_1_def Transformation_def
  by clarsimp metis

subparagraph ‹1-to-1λ›

lemma [φreason_template name F.G.rewr[]]:
  Tyops_CommuteΛI F F' G G' T D  (embedded_func f P)
 Tyops_CommuteΛE G' G F' F T D' (embedded_func g Q)
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x  D' (f x)  g (f x) = x
 (x  F (G T)) = (f x  G' (λp. F' (T p)))
  unfolding Tyops_CommuteΛI_def Tyops_CommuteΛE_def Transformation_def Premise_def BI_eq_iff
  by clarsimp metis

lemma [φreason_template name F.G.rewr[]]:
  Tyops_CommuteΛE F F' G G' T D  (embedded_func f P)
 Tyops_CommuteΛI G' G F' F T D' (embedded_func g Q)
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x  D' (f x)  g (f x) = x
 (x  F (λp. G (T p))) = (f x  G' (F' T))
  unfolding Tyops_CommuteΛI_def Tyops_CommuteΛE_def Transformation_def Premise_def BI_eq_iff
  by clarsimp metis

subparagraph ‹1-to-2›

lemma [φreason_template name F.G.rewr[]]:
  Tyops_Commute1_2 F F'T F'U G G' T U D  (embedded_func f P)
 Tyops_Commute2_1 F F'T F'U G G' T U D' (embedded_func g Q)
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x  D' (f x)  g (f x) = x
 (x  F (G T U)) = (f x  G' (F'T T) (F'U U))
  unfolding Tyops_Commute2_1_def Tyops_Commute1_2_def Premise_def Transformation_def
            BI_eq_iff
  by clarsimp metis

lemma [φreason_template name G'.F.rewr[]]:
  Tyops_Commute1_2 F F'T F'U G G' T U D  (embedded_func f P)
 Tyops_Commute2_1 F F'T F'U G G' T U D' (embedded_func g Q)
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D (g x)  D' x  f (g x) = x
 (x  G' (F'T T) (F'U U)) = (g x  F (G T U))
  unfolding Tyops_Commute2_1_def Tyops_Commute1_2_def Premise_def Transformation_def
            BI_eq_iff
  by clarsimp metis


paragraph ‹Deriving ToA›

subparagraph ‹1-to-1›

lemma [φreason_template name F.G.comm[no_atp]]:
  Tyops_Commute F F' G G' T D r
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
 (r, RE) = (embedded_func f P, (x  F (G T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x  G' (F' T) 𝗐𝗂𝗍𝗁 P x @tag 𝒯𝒫)) cut
    RE = (x  F (G T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  G' (F' T) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒯𝒫)
    @tag 𝒜_template_reason undefined
 RE
  unfolding Premise_def Action_Tag_def Tyops_Commute_def Orelse_shortcut_def
  by (elim disjE; simp)

subparagraph ‹1-to-1λ›

lemma [φreason_template name F.G.comm[no_atp]]:
  Tyops_CommuteΛI F F' G G' T D r
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
 (r, RE) = (embedded_func f P, (x  F (G T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x  G' (λp. F' (T p)) 𝗐𝗂𝗍𝗁 P x @tag 𝒯𝒫)) cut
    RE = (x  F (G T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  G' (λp. F' (T p)) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒯𝒫) @tag 𝒜_template_reason undefined
 RE
  unfolding Premise_def Action_Tag_def Tyops_CommuteΛI_def Orelse_shortcut_def Transformation_def
  by (elim disjE; simp)

lemma [φreason_template name F.G.comm[no_atp]]:
  Tyops_CommuteΛE F F' G G' T D r
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
 (r, RE) = (embedded_func f P, (x  F (λp. G (T p)) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x  G' (F' T) 𝗐𝗂𝗍𝗁 P x @tag 𝒯𝒫)) cut
    RE = (x  F (λp. G (T p)) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  G' (F' T) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒯𝒫) @tag 𝒜_template_reason undefined
 RE
  unfolding Premise_def Action_Tag_def Tyops_CommuteΛE_def Orelse_shortcut_def Transformation_def
  by (elim disjE; simp)


subparagraph ‹1-to-2›

lemma Comm_Tyops1_2_ToA_temlpate[φreason_template name F.G.comm[no_atp]]:
  Tyops_Commute1_2 F F'T F'U G G' T U D r
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
 (r, RE) = (embedded_func f P, (x  F (G T U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x  G' (F'T T) (F'U U) 𝗐𝗂𝗍𝗁 P x @tag 𝒯𝒫)) cut
    RE = (x  F (G T U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  G' (F'T T) (F'U U) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒯𝒫) @tag 𝒜_template_reason undefined
 RE
  unfolding Premise_def Action_Tag_def Tyops_Commute1_2_def Orelse_shortcut_def
  by (elim disjE; simp)

lemma Comm_Tyops2_1_ToA_temlpate[φreason_template name F.G.comm[no_atp]]:
  Tyops_Commute2_1 F F'T F'U G G' T U D r
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
 (r, RE) = (embedded_func f P, (x  G' (F'T T) (F'U U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x  F (G T U) 𝗐𝗂𝗍𝗁 P x @tag 𝒯𝒫)) cut
    RE = (x  G' (F'T T) (F'U U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  F (G T U) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒯𝒫) @tag 𝒜_template_reason undefined
 RE
  unfolding Premise_def Action_Tag_def Tyops_Commute2_1_def Orelse_shortcut_def
  by (elim disjE; simp )


paragraph ‹Swapping Normalization›

subparagraph ‹1-to-1›

lemma [φreason_template name F.G.norm_src [φToA_SA_norm_simp default]]:
  𝗀𝗎𝖺𝗋𝖽 Tyops_Commute F F' G G' T D r
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
 (y. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 r' y : r x y @tag 𝒜_template_reason undefined)
 x  F (G T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  G' (F' T) 𝗌𝗎𝖻𝗃 y. r' y @tag 𝒜_transitive_simp
  unfolding Transformation_def Action_Tag_def Tyops_Commute_def Premise_def
            Simplify_def Action_Tag_def 𝗋Guard_def
  by clarsimp

lemma [φreason_template name F.G.norm_tgt [φToA_SA_norm_simp default]]:
  𝗀𝗎𝖺𝗋𝖽 Tyops_Commute F F' G G' T D r
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
 (y. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 r' y : r x y @tag 𝒜_template_reason undefined)
 x  F (G T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  G' (F' T) 𝗌𝗎𝖻𝗃 y. r' y @tag 𝒜_backward_transitive_simp
  unfolding Transformation_def Action_Tag_def Tyops_Commute_def Premise_def
            Simplify_def Action_Tag_def 𝗋Guard_def
  by clarsimp

paragraph ‹1-to-2›

lemma [φreason_template name F.G.norm_src [φToA_SA_norm_simp default]]:
  𝗀𝗎𝖺𝗋𝖽 Tyops_Commute1_2 F F'T F'U G G' T U D r
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
 (y. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 r' y : r x y @tag 𝒜_template_reason undefined)
 x  F (G T U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  G' (F'T T) (F'U U) 𝗌𝗎𝖻𝗃 y. r' y @tag 𝒜_transitive_simp
  unfolding Tyops_Commute1_2_def Action_Tag_def Tyops_Commute_def Premise_def Simplify_def 𝗋Guard_def
  by clarsimp

lemma [φreason_template name F.G.norm_tgt [φToA_SA_norm_simp default]]:
  𝗀𝗎𝖺𝗋𝖽 Tyops_Commute2_1 F F'T F'U G G' T U D r
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
 (y. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 r' y : r x y @tag 𝒜_template_reason undefined)
 x  G' (F'T T) (F'U U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  F (G T U) 𝗌𝗎𝖻𝗃 y. r' y @tag 𝒜_backward_transitive_simp
  unfolding Tyops_Commute2_1_def Action_Tag_def Tyops_Commute_def Premise_def Simplify_def 𝗋Guard_def
  by clarsimp

paragraph ‹2-to-1›

lemma [φreason_template name F.G.norm_src [φToA_SA_norm_simp default]]:
  𝗀𝗎𝖺𝗋𝖽 Tyops_Commute2_1 F F'T F'U G G' T U D r
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
 (y. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 r' y : r x y @tag 𝒜_template_reason undefined)
 x  G' (F'T T) (F'U U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  F (G T U) 𝗌𝗎𝖻𝗃 y. r' y @tag 𝒜_transitive_simp
  unfolding Tyops_Commute2_1_def Action_Tag_def Tyops_Commute_def Premise_def Simplify_def 𝗋Guard_def
  by clarsimp

lemma [φreason_template name F.G.norm_tgt [φToA_SA_norm_simp default]]:
  𝗀𝗎𝖺𝗋𝖽 Tyops_Commute1_2 F F'T F'U G G' T U D r
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
 (y. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 r' y : r x y @tag 𝒜_template_reason undefined)
 x  F (G T U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  G' (F'T T) (F'U U) 𝗌𝗎𝖻𝗃 y. r' y @tag 𝒜_backward_transitive_simp
  unfolding Tyops_Commute1_2_def Action_Tag_def Tyops_Commute_def Premise_def Simplify_def 𝗋Guard_def
  by clarsimp

paragraph Λ›

lemma [φreason_template name F.G.norm_src [φToA_SA_norm_simp default]]:
  Tyops_CommuteΛI F F' G G' T D r
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
 x  F (G T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  G' (λp. F' (T p)) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒜_transitive_simp
  unfolding Tyops_CommuteΛI_def Action_Tag_def Tyops_Commute_def Premise_def
  by clarsimp

lemma [φreason_template name F.G.norm_src [φToA_SA_norm_simp default]]:
  𝗀𝗎𝖺𝗋𝖽 Tyops_CommuteΛE F F' G G' T D r
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
 x  F (λp. G (T p)) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  G' (F' T) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒜_transitive_simp
  unfolding Tyops_CommuteΛE_def Action_Tag_def Tyops_Commute_def Premise_def 𝗋Guard_def
  by clarsimp

lemma [φreason_template name F.G.norm_tgt [φToA_SA_norm_simp default]]:
  𝗀𝗎𝖺𝗋𝖽 Tyops_CommuteΛI F F' G G' T D r
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
 x  F (G T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  G' (λp. F' (T p)) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒜_backward_transitive_simp
  unfolding Tyops_CommuteΛI_def Action_Tag_def Tyops_Commute_def Premise_def 𝗋Guard_def
  by clarsimp

lemma [φreason_template name F.G.norm_tgt [φToA_SA_norm_simp default]]:
  𝗀𝗎𝖺𝗋𝖽 Tyops_CommuteΛE F F' G G' T D r
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
 x  F (λp. G (T p)) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  G' (F' T) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒜_backward_transitive_simp
  unfolding Tyops_CommuteΛE_def Action_Tag_def Tyops_Commute_def Premise_def 𝗋Guard_def
  by clarsimp


paragraph ‹Bubbling›

subparagraph ‹1-to-1›

lemma [φreason_template default %φsimp_derived_bubbling]:
  𝗀𝗎𝖺𝗋𝖽 Tyops_Commute F F' G G' T D r
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
 x  F (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 G T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 G' (F' T) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒜simp
  unfolding Tyops_Commute_def Premise_def Action_Tag_def Bubbling_def Simplify_def 𝗋Guard_def
  by clarsimp

lemma [φreason_template default %φsimp_derived_bubbling]:
  𝗀𝗎𝖺𝗋𝖽 Tyops_Commute F F' G G' T D r
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
 x  𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F (G T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  G' (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F' T) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒜backward_simp
  unfolding Tyops_Commute_def Premise_def Bubbling_def Transformation_def Action_Tag_def 𝗋Guard_def
  by clarsimp


subparagraph ‹1-to-2›

lemma [φreason_template default %φsimp_derived_bubbling]:
  𝗀𝗎𝖺𝗋𝖽 Tyops_Commute1_2 F F'T F'U G G' T U D r
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
 x  F (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 G T U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 G' (F'T T) (F'U U) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒜simp
  unfolding Tyops_Commute1_2_def Premise_def Action_Tag_def Bubbling_def Simplify_def 𝗋Guard_def
  by clarsimp

lemma [φreason_template default %φsimp_derived_bubbling+1]:
  𝗀𝗎𝖺𝗋𝖽 Tyops_Commute1_2 F F'T F'U G G' T U D r
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
 x  𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F (G T U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  G' (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F'T T) (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F'U U) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒜backward_simp
  unfolding Tyops_Commute1_2_def Premise_def Bubbling_def Action_Tag_def 𝗋Guard_def
  by clarsimp

lemma [φreason_template default %φsimp_derived_bubbling]:
  𝗀𝗎𝖺𝗋𝖽 Tyops_Commute1_2 F F'T F'U G G' T U D r
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
 x  𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F (G T U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  G' (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F'T T) (F'U U) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒜backward_simp
  unfolding Tyops_Commute1_2_def Premise_def Bubbling_def Action_Tag_def 𝗋Guard_def
  by clarsimp

lemma [φreason_template default %φsimp_derived_bubbling]:
  𝗀𝗎𝖺𝗋𝖽 Tyops_Commute1_2 F F'T F'U G G' T U D r
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
 x  𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F (G T U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  G' (F'T T) (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F'U U) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒜backward_simp
  unfolding Tyops_Commute1_2_def Premise_def Bubbling_def Action_Tag_def 𝗋Guard_def
  by clarsimp


subparagraph ‹2-to-1›

lemma [φreason_template default %φsimp_derived_bubbling+1]:
  𝗀𝗎𝖺𝗋𝖽 Tyops_Commute2_1 F F'T F'U G G' T U D r
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
 x  G' (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F'T T) (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F'U U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F (G T U) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒜simp
  unfolding Tyops_Commute2_1_def Premise_def Action_Tag_def Bubbling_def Simplify_def 𝗋Guard_def
  by clarsimp

lemma [φreason_template default %φsimp_derived_bubbling]:
  𝗀𝗎𝖺𝗋𝖽 Tyops_Commute2_1 F F'T F'U G G' T U D r
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
 x  G' (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F'T T) (F'U U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F (G T U) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒜simp
    <except-pattern> x  G' (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F'T T) (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F'U U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 YYY @tag 𝒜simp
  unfolding Tyops_Commute2_1_def Premise_def Action_Tag_def Bubbling_def Except_Pattern_def Simplify_def 𝗋Guard_def
  by clarsimp

lemma [φreason_template default %φsimp_derived_bubbling]:
  𝗀𝗎𝖺𝗋𝖽 Tyops_Commute2_1 F F'T F'U G G' T U D r
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
 x  G' (F'T T) (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F'U U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F (G T U) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒜simp
    <except-pattern> x  G' (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F'T T) (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F'U U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 YYY @tag 𝒜simp
  unfolding Tyops_Commute2_1_def Premise_def Action_Tag_def Bubbling_def Except_Pattern_def Simplify_def 𝗋Guard_def
  by clarsimp

lemma [φreason_template default %φsimp_derived_bubbling]:
  𝗀𝗎𝖺𝗋𝖽 Tyops_Commute2_1 F F'T F'U G G' T U D r
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
 x  𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 G' (F'T T) (F'U U) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  F (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 G T U) 𝗌𝗎𝖻𝗃 y. r x y @tag 𝒜backward_simp
  unfolding Tyops_Commute2_1_def Premise_def Bubbling_def Action_Tag_def 𝗋Guard_def
  by clarsimp


subparagraph ‹1-to-1λ›

lemma [φreason_template default %φsimp_derived_bubbling]:
  Tyops_CommuteΛI F F' G G' T D r
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
 (x  F (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 G T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 G' (λp. F' (T p)) 𝗌𝗎𝖻𝗃 y. r x y) @tag 𝒜simp
  unfolding Tyops_CommuteΛI_def Premise_def Bubbling_def Action_Tag_def Simplify_def
  by simp

lemma [φreason_template default %φsimp_derived_bubbling]:
  Tyops_CommuteΛE F F' G G' T D r
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
 (x  F (λp. G (T p)) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  G' (F' T) 𝗌𝗎𝖻𝗃 y. r x y) @tag 𝒜simp
  unfolding Tyops_CommuteΛE_def Premise_def Bubbling_def Action_Tag_def Simplify_def
  by simp


paragraph ‹To-Transformation Interpreter›

lemma [φreason_template default %To_ToA_derived]:
  𝗀𝗎𝖺𝗋𝖽 Tyops_Commute F F' G G' T D r
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x
 x  F (G T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  G' (F' T) 𝗌𝗎𝖻𝗃 y. r x y @tag to (𝖼𝗈𝗆𝗆𝗎𝗍𝖾 F G)
  unfolding Tyops_Commute_def Premise_def Action_Tag_def Except_Pattern_def Simplify_def 𝗋Guard_def
  by clarsimp


section ‹Property Derivers›

subsection ‹Extension of BNF-FP›

ML_file ‹library/phi_type_algebra/tools/BNF_fp_sugar_more.ML›
ML_file ‹library/phi_type_algebra/tools/extended_BNF_info.ML›



subsection ‹Deriver Framework›

consts φTA_subgoal :: action  action
       φTA_ANT :: action ― ‹Antecedent in the outcome›
       φTA_conditioned_ToA_template :: action
       φTA_pure_facts :: action ― ‹About φTA_conditioned_ToA_template› and φTA_pure_facts›,
                                    see comments in 🗏‹library/phi_type_algebra/deriver_framework.ML›
                                    ML function default_reasoning_configure›
       φTA_ToA_elim :: action

definition φTA_IND_TARGET T = T

lemmas intro_φTA_ANT = Action_Tag_def[where A=φTA_ANT, symmetric, THEN Meson.TruepropI]

lemma mk_ToA_rule:
  A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 P
 X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A 𝗐𝗂𝗍𝗁 Q @tag 𝒯𝒫
 X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 Q  P @tag 𝒯𝒫
  using transformation_trans Action_Tag_def
  by blast

lemma mk_ToA_rule':
  A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗐𝗂𝗍𝗁 P
 X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 R 𝗐𝗂𝗍𝗁 Q @tag 𝒯𝒫
 X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 B 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 R 𝗐𝗂𝗍𝗁 Q  P @tag 𝒯𝒫
  unfolding REMAINS_def Action_Tag_def
  by (simp add: transformation_right_frame transformation_trans)

lemma mk_ToA_rule_varified:
  A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x'  T 𝗐𝗂𝗍𝗁 P
 Object_Equiv T eq
 (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 eq x' x  X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A 𝗐𝗂𝗍𝗁 Q @tag 𝒯𝒫)
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 eq x' x
 X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x  T 𝗐𝗂𝗍𝗁 Q  P @tag 𝒯𝒫
  unfolding Premise_def Object_Equiv_def Transformation_def Action_Tag_def
  by clarsimp blast

lemma mk_ToA_rule'_varified:
  A 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x'  T 𝗐𝗂𝗍𝗁 P
 Object_Equiv T eq
 (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 eq x' x  X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 R 𝗐𝗂𝗍𝗁 Q @tag 𝒯𝒫)
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 eq x' x
 X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x  T 𝗋𝖾𝗆𝖺𝗂𝗇𝗌 R 𝗐𝗂𝗍𝗁 Q  P @tag 𝒯𝒫
  unfolding REMAINS_def Premise_def Object_Equiv_def Transformation_def Action_Tag_def
  by (clarsimp; blast)


lemma [fundef_cong]:
  T x = T' x'  (x  T) = (x'  T')
  unfolding φType_def by simp

lemma φTA_ind_target_strip:
  X @tag φTA_subgoal 𝒜  X @tag 𝒜
  unfolding Action_Tag_def .

(*TODO: rename Action_Tag ⟶ Reasoning_Tag, @tag → @tag*)

lemma φTA_common_rewr_imp1:
  Trueprop (Ant  X @tag φTA_subgoal A)  (Ant  X @tag A)
  unfolding Action_Tag_def atomize_imp .

lemma φTA_common_rewr_imp1_noact:
  Trueprop (Ant  X @tag φTA_subgoal A)  (Ant  X)
  unfolding Action_Tag_def atomize_imp .

lemma φTA_common_rewr_imp1_rev:
  (Ant  X @tag A)  Trueprop (Ant  X @tag A)
  unfolding Action_Tag_def atomize_imp .

lemma φTA_common_rewr_imp2:
  Trueprop (Ant  C  X @tag φTA_subgoal 𝒜)
  (Ant  C  X @tag 𝒜)
  unfolding Action_Tag_def atomize_imp .

lemma φTA_common_rewr_imp2':
  Trueprop (Ant  Q  P @tag φTA_subgoal 𝒜)
  (Ant  Q  (P @tag 𝒜))
  unfolding Action_Tag_def atomize_imp .

lemma φTA_common_rewr_imp2_rev:
  (Ant  C  X @tag 𝒜)  Trueprop (Ant  C  X @tag 𝒜)
  unfolding Action_Tag_def atomize_imp .

lemma φTA_common_rewr_imp2_noact:
  Trueprop (Ant  C  X @tag φTA_subgoal A)
  (Ant  C  X)
  unfolding Action_Tag_def atomize_imp .

lemma φTA_reason_rule__simp:
  X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X' 𝗐𝗂𝗍𝗁 Any' @tag 𝒜_apply_simplication
 X' 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y
 X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y @tag 𝒜simp
  unfolding Action_Tag_def
  by (simp add: Transformation_def)

lemma φTA_reason_rule__𝒜_simp:
  X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X' 𝗐𝗂𝗍𝗁 Any @tag 𝒜_map_each_item A
 X' 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 X'' 𝗐𝗂𝗍𝗁 Any' @tag 𝒜_apply_simplication
 X'' 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y
 X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y @tag A
  unfolding Action_Tag_def
  by (simp add: Transformation_def)

lemma elim_TA_ANT:
  ((PROP A  PROP C)  PROP A  PROP B)  (PROP A  PROP C  PROP B)
  apply rule
  subgoal premises prems by (rule prems(1), rule prems(3), rule prems(2))
  subgoal premises prems by (rule prems(1), rule prems(3), rule prems(2), rule prems(3)) .


ML_file ‹library/phi_type_algebra/deriver_framework.ML›

consts φderiver_expansion :: mode

φreasoner_ML φderiver_expansion %cutting
  (Premise φderiver_expansion _ | Simplify φderiver_expansion ?X' ?X )
  = Phi_Reasoners.wrap (PLPR_Simplifier.simplifier (K Seq.empty)
        Phi_Type_Derivers.equip_expansion_ss0 {fix_vars=true}) o snd


subsection ‹Extending Property Guessers›

text ‹When derivers provide gussers of specific strategies typically based on the logic types of the
  abstract domain, boolean constraints implies inside can in addition augment the guessing.
  The section aims to provide a general mechanism syntactically extracting the constraints.

  The extraction works in two modes,
   covariant, where the boolean constraints are proof obligations have to be shown, and the φ-type
      typically locates at the right hand side of a transformation;
   contra-variant, where the constraints are conditions constraining the proof obligations, and the
      φ-type typically locates at the left hand side of a transformation.
›



  ― ‹A general mechanism to provide user heuristics which guesses the entire property
      of some specific forms of φ-types›

text ‹When guessing the property, the system first tries to see if there is any user overridings
  by Guess_Property› reasoning which gives the desired property entirely, if not, it goes to the normal
  guesser procedure implemented by each deriver, and after obtaining the guessed property,
  the system runs the Guess_Property› again with the guessed_conclusion› setting to None to force
  guessing the antecedents only, in this way to refine the already guessed antecedent either by
  adding new antecedents or constraining the antecedents by conditions.›

type_synonym variant = bool ―‹True for covariant, False for contravariant, undefined for invariant›

definition Guess_Property :: 'property_const  variant  ('c,'a) φ  ('c,'a) φ  bool  ('a  bool)  ('a  bool)  bool
  where Guess_Property the_constant_of_the_property_predicate ― ‹gives which sort of properties we are guessing›
                        variantness_of_the_property
                        original_φtype unfolded_φtype
                        guessed_antecedents guessed_proof_obligation yielded_conditions
           True
(*
definition Guess_Property :: ‹'property_const ⇒ variant ⇒ 'a BI ⇒ bool ⇒ bool ⇒ bool option ⇒ bool›
  where ‹Guess_Property the_constant_of_the_property_predicate
                        variantness_of_the_property
                        unfolded_φtype_definition
                        guessed_antecedents
                        conditions_of_antecedents
                        guessed_conclusion ― ‹None for the mode guessing antecedents only›
          ≡ True›
*)
declare [[
  φreason_default_pattern Guess_Property ?PC ?V ?T ?uT _ _ _ 
                          Guess_Property ?PC ?V ?T ?uT _ _ _ (100)
]]

φreasoner_group φTA_guesser = (100, [80, 2999]) for Guess_Property PC V T uT a pa cond
    ‹User heuristics overriding or extending the guesser mechanism of φtype derivers.›
 and φTA_guesser_init = (3000, [3000, 3000]) for Guess_Property PC V T uT a pa cond > φTA_guesser
    ‹Initializing the Guessing›
 and φTA_guesser_default = (30, [2, 79]) for Guess_Property PC V T uT a pa cond < φTA_guesser
    ‹Default rules handling logical connectives›
 and φTA_guesser_assigning_variant = (2200, [2200,2200]) for Guess_Property PC V T uT a pa cond
                                                          in φTA_guesser and > φTA_guesser_default
    ‹Fallbacks using common default rules›
 and φTA_guesser_fallback = (1,[1,1]) for Guess_Property PC V T uT a pa cond < φTA_guesser_default
    ‹Fallbacks of Guess_Property›
                
ML_file ‹library/phi_type_algebra/guess_property.ML›

paragraph ‹System Rules›

lemma [φreason default %φTA_guesser_fallback]:
  Guess_Property PC V T T' True (λ_. True) (λ_. True)
  unfolding Guess_Property_def ..

lemma [φreason default %φTA_guesser_init]:
  (x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_T' x) : (x  T) )
 Guess_Property PC V T var_T' a p c
 Guess_Property PC V T var_T' a p c
  unfolding Guess_Property_def ..

paragraph ‹Preset›

lemma [φreason default %φTA_guesser_default]:
  Guess_Property PC False T A a p c
 Guess_Property PC False T (λx. A x 𝗌𝗎𝖻𝗃 P x) a p (λx. P x  c x)
  (c. Guess_Property PC False T (λx. A' x c) (a' c) (p' c) (cond c))
 Guess_Property PC False T (λx. ExBI (A' x)) (All a') (λx. c. p' c x) (λx. c. cond c x)
  unfolding Guess_Property_def ..

lemma [φreason default %φTA_guesser_default]:
  Guess_Property PC True T A a p c
 Guess_Property PC True T (λx. A x 𝗌𝗎𝖻𝗃 P x) a (λx. P x  p x) c
  (c. Guess_Property PC True T (λx. A' x c) (a' c) (c' c) (cond c))
 Guess_Property PC True T (λx. ExBI (A' x)) (Ex a') (λx. c. c' c x) (λx. c. cond c x)
  unfolding Guess_Property_def ..

lemma [φreason %φTA_guesser_default]:
  Guess_Property PC V T A a1 p1 c1
 Guess_Property PC V T B a2 p2 c2
 Guess_Property PC V T (λx. A x * B x) (a1 𝗋 a2) (λx. p1 x  p2 x) (λx. c1 x  c2 x)
  unfolding Guess_Property_def ..


subsection ‹Simplify Result›

definition Simplify_Result :: prop  prop  prop where Simplify_Result P Q  (PROP P  PROP Q)

lemma DO_Simplify_Result:
  PROP P
 PROP Simplify_Result P Q
 𝗋Success
 PROP Q
  unfolding Simplify_Result_def .

text ‹Simplifies only naked conditions (in sens of not wrapped by ⋀› or ⟹›) but not arbitrary antecedents›

paragraph ‹Basic Rules›

lemma
  PROP 𝒜EIF' A A'
 (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 A'  PROP Simplify_Result (PROP B) (PROP B'))
 PROP Simplify_Result (PROP A  PROP B) (PROP A  PROP B')
  unfolding Simplify_Result_def Premise_def 𝒜EIF'_def
  subgoal premises prems
    by (rule prems(2), rule prems(1), rule prems(4), rule prems(3), rule prems(4)) .
    



subsection ‹Warn if the Def contains Sat›

φproperty_deriver Warn_if_contains_Sat 10 = fn (quiet, _) => fn [] => fn phi => fn thy => (
  if Phi_Syntax.is_nonnull_Type_Opr (Term.fastype_of (#term phi)) andalso
     Phi_Type.def_contains_satisfaction phi andalso
     not quiet
  then warning ("The φ-type definition contains satisfaction operator (⊨).\n\
                \When a φ-type is specified by satisfaction in a boolean assertion, it looses the ability to guide the reasoning.\n\
                \The deriving may fail. It is recommended to use composition operator (⨾) to replace the (⊨) if possible.")
  else () ;
  thy
)


subsection ‹Meta Deriver for Pure Syntactical Properties›

ML_file ‹library/phi_type_algebra/gen_pure_synt_rules.ML›

φproperty_deriver Semimodule_No_SDistr 100
    = Phi_Type_Derivers.meta_Synt_Deriver
          ("Semimodule_No_SDistr",
           @{lemma' Semimodule_No_SDistr F by (simp add: Semimodule_No_SDistr_def)},
           SOME (@{reasoner_group %Semimodule_No_SDistr}))


subsection ‹Abstract Domain›

context begin

private lemma φTA_Inh_rule:
  (x. Ant  (x  OPEN undefined T 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 P x) @tag φTA_subgoal undefined)
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 Ant @tag φTA_ANT
 Abstract_Domain T P
  unfolding Action_Tag_def Abstract_Domain_def OPEN_def 𝗋EIF_def
  by simp

private lemma φTA_SuC_rule:
  (x. Ant  (P x 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 x  MAKE undefined T) @tag φTA_subgoal undefined)
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 Ant @tag φTA_ANT
 Abstract_DomainL T P
  unfolding Action_Tag_def Abstract_DomainL_def MAKE_def 𝗋ESC_def
  by simp

private lemma φTA_Inh_step:
  Inh 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 Any
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (Any  P)
 Inh 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 P
  unfolding Action_Tag_def Premise_def 𝗋EIF_def
  by blast

private lemma φTA_Suc_step:
  Any 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 Inh
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (P  Any)
 P 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 Inh
  unfolding Action_Tag_def Premise_def 𝗋ESC_def
  by blast

private lemma φTA_Inh_rewr_IH:
  Trueprop (Ant  (x  OPEN undefined T 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 P) @tag φTA_subgoal A)
  (Ant  (x  T 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 P))
  unfolding Action_Tag_def atomize_imp OPEN_def .

private lemma φTA_Suc_rewr_IH:
  Trueprop (Ant  (P 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 x  MAKE undefined T) @tag φTA_subgoal A)
  (Ant  (P 𝗌𝗎𝖿𝖿𝗂𝖼𝖾𝗌 x  MAKE undefined T))
  unfolding Action_Tag_def atomize_imp OPEN_def .


ML_file ‹library/phi_type_algebra/implication.ML›

end

(*hide_fact φTA_Inh_rule φTA_Inh_rewr φTA_Inh_step*)

φproperty_deriver Abstract_DomainL 89 for ( Abstract_DomainL _ _ ) = Phi_Type_Derivers.abstract_domain_L

φproperty_deriver Abstract_Domain 90 for ( Abstract_Domain _ _ )  = Phi_Type_Derivers.abstract_domain



subsection ‹Identity Element Intro \& Elim›

context begin

private lemma φTA_1L_rule:
  (x. Ant  𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x  Identity_ElementI (x  OPEN undefined T) (P x) @tag φTA_subgoal undefined)
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 Ant @tag φTA_ANT
 Identity_ElementsI T D P
  unfolding Action_Tag_def Identity_ElementsI_def OPEN_def
  by blast

private lemma φTA_1R_rule:
  (x. Ant  𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x  Identity_ElementE (x  MAKE undefined T) @tag φTA_subgoal undefined)
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 Ant @tag φTA_ANT
 Identity_ElementsE T D
  unfolding Action_Tag_def Identity_ElementsE_def MAKE_def
  by blast

private lemma φTA_Ident_I_rule_step:
  X 𝗂𝗆𝗉𝗅𝗂𝖾𝗌 A
 (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 A  Identity_ElementI X Q)
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (A  Q  P)
 Identity_ElementI X P
  unfolding Identity_ElementI_def Premise_def Action_Tag_def Transformation_def Satisfiable_def 𝗋EIF_def
  by (clarsimp, blast)

(* not enabled, DO NOT REMOVE, I am a bit of hesitate
lemma φTA_1I_simp:
  ‹ Identity_ElementsI T D P
⟹ Abstract_Domain T Q
⟹ (⋀x. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Q x ⟹ 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 D' x : D x)
⟹ (⋀x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 P' x : P x)
⟹ Identity_ElementsI T D' P' ›
  unfolding Identity_ElementsI_def Premise_def Simplify_def Abstract_Domain_def Identity_ElementI_def
            Action_Tag_def Transformation_def Satisfiable_def
  by clarsimp blast*)

ML_file ‹library/phi_type_algebra/identity_element.ML›

end


φproperty_deriver Identity_ElementsI 101 for (Identity_ElementsI _ _ _)
  = Phi_Type_Derivers.identity_element_I

φproperty_deriver Identity_ElementsE 102 for (Identity_ElementsE _ _)
  = Phi_Type_Derivers.identity_element_E

φproperty_deriver Identity_Element_PropertiesI 103
  = fn (_, pos) => (K (Phi_Type_Derivers.id_ele_properties pos true))

φproperty_deriver Identity_Element_PropertiesE 103
  = fn (_, pos) =>  (K (Phi_Type_Derivers.id_ele_properties pos false))

φproperty_deriver Identity_Element_Properties 104
  requires Identity_Element_PropertiesI and Identity_Element_PropertiesE

φproperty_deriver Identity_Elements 105
  requires Identity_ElementsI and Identity_ElementsE and Identity_Element_Properties


paragraph ‹Guessing Antecedents›


subsection ‹Object Equivalence›

context begin

private lemma Object_Equiv_rule:
  𝗋EIF Ant Ant'
 (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ant'  𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (x. eq x x))
 (x y. Ant  eq x y  (x  OPEN undefined T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  MAKE undefined T) @tag φTA_subgoal undefined)
              ― ‹Induct over x ⦂ T›. When x› is inductively split, the constraint of eq x y›
                  should also split y›, so that y ⦂ T› can reduce.
                  A deficiency is, when the relation eq› is trivially true such as that when
                   T = List ○›, ›
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 Ant @tag φTA_ANT
 Object_Equiv T eq
  unfolding Object_Equiv_def Premise_def Action_Tag_def MAKE_def OPEN_def 𝗋EIF_def
  by blast

private lemma φTA_OE_rewr_IH:
  Trueprop (Ant  (y. P y  (x  OPEN undefined T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f y  MAKE undefined U)) @tag φTA_subgoal undefined)
 (y. Ant  𝗉𝗋𝖾𝗆𝗂𝗌𝖾 P y  x  T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f y  φTA_IND_TARGET U @tag φTA_ToA_elim)
  unfolding Action_Tag_def atomize_imp atomize_all Premise_def OPEN_def MAKE_def
            φTA_IND_TARGET_def
  by (rule; blast)


private lemma φTA_OE_rewr_pre:
  (y. Ant  P y  C y @tag 𝒜)
  Trueprop (Ant  (y. P y  C y) @tag 𝒜)
  unfolding Action_Tag_def atomize_imp atomize_all
  by (rule; blast)

private lemma φTA_OE_rewr_CL:
  Trueprop (Ant  (y. C y  X y) @tag 𝒜)
  (y. Ant  C y  X y)
  unfolding Action_Tag_def atomize_imp atomize_all Premise_def OPEN_def MAKE_def
  by (rule; blast)

lemma ex_pure_imp:
  (x. P x  PROP Q)  (x. P x  PROP Q)
proof
  fix x
  assume A: x. P x  PROP Q
     and B: P x
  from B have x. P x by blast
  from A[OF this] show PROP Q .
next
  assume A: x. P x  PROP Q
     and B: x. P x
  from B have P (@x. P x) by (simp add: someI_ex) 
  from A[OF this] show PROP Q .
qed



private lemma φTA_OE_rewr:
  Trueprop (y. P y  Q y)  (y. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 P y  Q y)
  unfolding Action_Tag_def atomize_imp atomize_all Premise_def
  by (rule; blast)

private lemma φTA_OE_rewr':
  Trueprop (y. P y  Q y)  (y. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 P y  Q y)
  unfolding Action_Tag_def atomize_imp atomize_all Premise_def
  by (rule; blast)

private lemma φTA_OE_simp:
  Object_Equiv T eq
 Abstract_Domain T D
 (x y. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 D x  𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 eq' x y : eq x y)
 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 ((x. eq x x)  (x. eq' x x))
 Object_Equiv T eq'
  unfolding Object_Equiv_def Transformation_def Simplify_def Premise_def
            Abstract_Domain_def Action_Tag_def Satisfiable_def 𝗋EIF_def
  by clarsimp blast

ML_file ‹library/phi_type_algebra/object_equiv.ML›

end


φproperty_deriver Object_Equiv 105 for (Object_Equiv _ _)
  = Phi_Type_Derivers.object_equiv


subsection ‹Functionality›

context begin

private lemma φTA_IsFunc_rule:
  (x. Ant 
         𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 P x 
         Is_Functional (x  OPEN undefined T) @tag φTA_subgoal undefined)
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 Ant @tag φTA_ANT
 Functionality T P
  unfolding Action_Tag_def Functionality_def Is_Functional_def Premise_def OPEN_def
  by clarsimp

private lemma φTA_IsFunc_cong:
  P  P'
 Functionality T P  Functionality T P'
  by simp

private lemma φTA_IsFunc_rewr_IH:
  Trueprop (Ant  C  Is_Functional (x  OPEN undefined T) @tag φTA_subgoal A)
  (Ant  C  Is_Functional (x  T))
  unfolding Action_Tag_def atomize_imp OPEN_def .

ML_file ‹library/phi_type_algebra/is_functional.ML›

end

φproperty_deriver Functionality 100 for (Functionality _ _)
    = Phi_Type_Derivers.is_functional


subsection ‹Carrier Set›

context begin

private lemma φTA_CarS_rule:
  (x. Ant 
          𝗉𝗋𝖾𝗆𝗂𝗌𝖾 P x 
          Within_Carrier_Set (x  OPEN undefined T) @tag φTA_subgoal undefined)
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 Ant @tag φTA_ANT
 Carrier_Set T P
  unfolding Carrier_Set_def Action_Tag_def Premise_def OPEN_def
  by clarsimp

private lemma φTA_CarS_cong:
  P  P'
 Carrier_Set T P  Carrier_Set T P'
  by simp

private lemma φTA_CarS_rewr_IH:
  Trueprop (Ant  C  Within_Carrier_Set (x  OPEN undefined T) @tag φTA_subgoal A)
  (Ant  C  Within_Carrier_Set (x  T))
  unfolding Action_Tag_def atomize_imp OPEN_def .

ML_file ‹library/phi_type_algebra/carrier_set.ML›

end

φproperty_deriver Carrier_Set 100 for (Carrier_Set _ _)
    = Phi_Type_Derivers.carrier_set

φproperty_deriver Basic 109
  requires Object_Equiv and Abstract_Domain and Carrier_Set ?


subsection ‹Type Inhabitance›

context begin

private lemma inh_typ_derv_rule:
  (Ant @tag φTA_ANT  Inhabited T)
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 Ant @tag φTA_ANT
 Inhabited T .

ML_file ‹library/phi_type_algebra/inhabited_type.ML›

end

φproperty_deriver Inhabited 100 for (Inhabited _)
    = Phi_Type_Derivers.inhabited_type 



subsection ‹Equivalent Class›

context begin

private lemma φTA_EC_rule:
  (Ant  Equiv_Class (λx. x  OPEN undefined T) r @tag φTA_subgoal undefined)
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 Ant @tag φTA_ANT
 Equiv_Class T r
  unfolding Action_Tag_def OPEN_def φType_def .

ML_file ‹library/phi_type_algebra/equiv_class.ML›

end

φproperty_deriver Equiv_Class 100 for (Equiv_Class _ _)
    = Phi_Type_Derivers.equiv_class 


subsection ‹Transformation Functor›

context begin

private lemma φTA_TF_rule:
  (g x. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (a b. a  D x  g a b  b  R x) 
              Ant 
              (a. 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 a  D x  a  T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U 𝗌𝗎𝖻𝗃 b. g a b @tag to U)  ― ‹split D›
              (x  OPEN undefined (F1 T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  MAKE undefined (F2 U) 𝗌𝗎𝖻𝗃 y. mapper g x y) @tag φTA_subgoal (to (𝗍𝗋𝖺𝗏𝖾𝗋𝗌𝖾 𝗉𝖺𝗍𝗍𝖾𝗋𝗇 T  U)))
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 Ant @tag φTA_ANT
 Transformation_Functor F1 F2 T U D R mapper
  unfolding Transformation_Functor_def Action_Tag_def Ball_def Premise_def
            OPEN_def MAKE_def
  by simp

private lemma φTA_TF_deriver_cong:
  D  D'
 (x. a. a  D' x  R x  R' x)
 (g x y. Satisfiable (x  F1 T)  Satisfiable (y  F2 U)  m g x y  m' g x y)
 Transformation_Functor F1 F2 T U D R m  Transformation_Functor F1 F2 T U D' R' m'
  unfolding Transformation_Functor_def atomize_eq Transformation_def Satisfiable_def
  by clarsimp blast

(*
lemma φTA_TF_rewr_IH:
  ‹Trueprop (Ant ⟶ (∀x. P x ⟶ A2 x) ⟶ C @tag φTA_subgoal (to (𝗍𝗋𝖺𝗏𝖾𝗋𝗌𝖾 𝗉𝖺𝗍𝗍𝖾𝗋𝗇 T ⇒ U)))
≡ (Ant ⟹ (⋀x. P x ⟹ A2 x @tag to U) ⟹ C @tag to U)›
  unfolding Action_Tag_def atomize_imp atomize_all .
*)

private lemma φTA_TF_rewr_C:
  Trueprop (Ant  (x. P x  A2 x)  C @tag φTA_subgoal 𝒜)
 (Ant  (x. P x  A2 x)  C @tag 𝒜)
  unfolding Action_Tag_def atomize_imp atomize_all .

private lemma φTA_TF_rewr_pre:
  (Ant  (x. P x  A2 x)  C @tag 𝒜)
  Trueprop (Ant  (x. P x  A2 x)  C @tag 𝒜)
  unfolding Action_Tag_def atomize_imp atomize_all .

paragraph ‹Bi-Functor›

private lemma φTA_biTF_rule:
  (g1 g2 x. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (a b. a  D1 x  g1 a b  b  R1 x)  (a b. a  D2 x  g2 a b  b  R2 x) 
              Ant 
              (a. 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 a  D1 x  a  T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U1 𝗌𝗎𝖻𝗃 b. g1 a b @tag to U1)  ― ‹split D›
              (a. 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 a  D2 x  a  T2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U2 𝗌𝗎𝖻𝗃 b. g2 a b @tag to U2)  ― ‹split D›
              (x  OPEN undefined (F1 T1 T2) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  MAKE undefined (F2 U1 U2) 𝗌𝗎𝖻𝗃 y. mapper g1 g2 x y)
              @tag φTA_subgoal (to (𝗍𝗋𝖺𝗏𝖾𝗋𝗌𝖾 𝗉𝖺𝗍𝗍𝖾𝗋𝗇 T1  U1 𝗈𝗋𝖾𝗅𝗌𝖾 𝗉𝖺𝗍𝗍𝖾𝗋𝗇 T2  U2)))
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 Ant @tag φTA_ANT
 Transformation_BiFunctor F1 F2 T1 T2 U1 U2 D1 D2 R1 R2 mapper
  unfolding Transformation_BiFunctor_def Action_Tag_def Ball_def Premise_def
            OPEN_def MAKE_def
  by simp

private lemma φTA_biTF_rewr_C:
  Trueprop (Ant  (x. P1 x  A1 x)  (x. P2 x  A2 x)  C @tag φTA_subgoal 𝒜)
 (Ant  (x. P1 x  A1 x)  (x. P2 x  A2 x)  C @tag 𝒜)
  unfolding Action_Tag_def atomize_imp atomize_all .

private lemma φTA_biTF_rewr_pre:
  (Ant  (x. P1 x  A1 x)  (x. P2 x  A2 x)  C @tag 𝒜)
  Trueprop (Ant  (x. P1 x  A1 x)  (x. P2 x  A2 x)  C @tag 𝒜)
  unfolding Action_Tag_def atomize_imp atomize_all .

private lemma φTA_biTF_deriver_cong:
  D1  D'1
 D2  D'2
 (x. a. a  D'1 x  R1 x  R'1 x)
 (x. a. a  D'2 x  R2 x  R'2 x)
 (g1 g2 x y. Satisfiable (x  F1 T1 T2)  Satisfiable (y  F2 U1 U2)  m g1 g2 x y  m' g1 g2 x y)
 Transformation_BiFunctor F1 F2 T1 T2 U1 U2 D1 D2 R1 R2 m
  Transformation_BiFunctor F1 F2 T1 T2 U1 U2 D'1 D'2 R'1 R'2 m'
  unfolding Transformation_BiFunctor_def atomize_eq Transformation_def Satisfiable_def
  by clarsimp (smt (verit, ccfv_threshold))

paragraph ‹Parameterization›

private lemma φTA_TFΛ_rule:
  (g x. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 (p a b. a  D p x  g p a b  b  R p x) 
              Ant 
              (p a. 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 a  D p x  a  T p 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 b  U p 𝗌𝗎𝖻𝗃 b. g p a b @tag to (U p))  ― ‹split D›
              (x  MAKE undefined (F1 T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  OPEN undefined (F2 U) 𝗌𝗎𝖻𝗃 y. mapper g x y) @tag φTA_subgoal (to (𝗍𝗋𝖺𝗏𝖾𝗋𝗌𝖾 𝗉𝖺𝗍𝗍𝖾𝗋𝗇 T  U)))
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 Ant @tag φTA_ANT
 Transformation_FunctorΛ F1 F2 T U D R mapper
  unfolding Transformation_FunctorΛ_def Action_Tag_def Ball_def Premise_def
            OPEN_def MAKE_def
  by clarsimp

private lemma φTA_TFΛ_deriver_cong:
  D  D'
 (p x. a. a  D' p x  R p x  R' p x)
 (g x y. Satisfiable (x  F1 T)  Satisfiable (y  F2 U)  m g x y  m' g x y)
 Transformation_FunctorΛ F1 F2 T U D R m  Transformation_FunctorΛ F1 F2 T U D' R' m'
  unfolding Transformation_FunctorΛ_def atomize_eq Transformation_def Satisfiable_def
  by clarsimp blast

private lemma φTA_TFΛ_rewr_C:
  Trueprop (Ant  (p x. P p x  A2 p x)  C @tag φTA_subgoal 𝒜)
 (Ant  (p x. P p x  A2 p x)  C @tag 𝒜)
  unfolding Action_Tag_def atomize_imp atomize_all .

private lemma φTA_TFΛ_rewr_pre:
  (Ant  (p x. P p x  A2 p x)  C @tag 𝒜)
  Trueprop (Ant  (p x. P p x  A2 p x)  C @tag 𝒜)
  unfolding Action_Tag_def atomize_imp atomize_all .


subsection ‹Functional Transformation Functor›

paragraph ‹Functor›

private lemma φTA_FTF_rule:
  𝗋EIF Ant Ant'
 (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ant'  Transformation_Functor F1 F2 T U D R mapper)
 (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ant'  Object_Equiv (F2 U) eq)
 (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ant'  𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (f P x y. mapper (λa b. b = f a  P a) x y  eq y (fm f P x)  pm f P x))
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 Ant @tag φTA_ANT
 Functional_Transformation_Functor F1 F2 T U D R pm fm
  unfolding Premise_def fun_eq_iff Action_Tag_def 𝗋EIF_def
  using infer_FTF_from_FT
  by blast

private lemma φTA_FTF_deriver_cong:
  D  D'
 (x. a. a  D' x  R x  R' x)
 (f P x. Satisfiable (x  F1 T)  fm f P x  fm' f P x)
 (f P x. Satisfiable (x  F1 T)  Satisfiable (fm' f P x  F2 U)  pm f P x  pm' f P x)
 Functional_Transformation_Functor F1 F2 T U D R pm fm 
    Functional_Transformation_Functor F1 F2 T U D' R' pm' fm'
  unfolding Functional_Transformation_Functor_def atomize_eq Transformation_def Satisfiable_def
  by (clarsimp, smt (verit, best))

paragraph ‹Bi-Functor›

private lemma φTA_biFTF_rule:
  𝗋EIF Ant Ant'
 (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ant'  Transformation_BiFunctor F1 F2 T1 T2 U1 U2 D1 D2 R1 R2 mapper)
 (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ant'  Object_Equiv (F2 U1 U2) eq)
 (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ant'  𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (f1 f2 P1 P2 x y. mapper (λa b. b = f1 a  P1 a) (λa b. b = f2 a  P2 a) x y
                                   eq y (fm f1 f2 P1 P2 x)  pm f1 f2 P1 P2 x))
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 Ant @tag φTA_ANT
 Functional_Transformation_BiFunctor F1 F2 T1 T2 U1 U2 D1 D2 R1 R2 pm fm
  unfolding Premise_def fun_eq_iff Action_Tag_def 𝗋EIF_def
  using infer_biFTF_from_biFT
  by blast

private lemma φTA_biFTF_deriver_cong:
  D1  D'1
 D2  D'2
 (x. a. a  D'1 x  R1 x  R'1 x)
 (x. a. a  D'2 x  R2 x  R'2 x)
 (f1 f2 P1 P2 x. Satisfiable (x  F1 T1 T2)  fm f1 f2 P1 P2 x  fm' f1 f2 P1 P2 x)
 (f1 f2 P1 P2 x. Satisfiable (x  F1 T1 T2)  Satisfiable (fm' f1 f2 P1 P2 x  F2 U1 U2)  pm f1 f2 P1 P2 x  pm' f1 f2 P1 P2 x)
 Functional_Transformation_BiFunctor F1 F2 T1 T2 U1 U2 D1 D2 R1 R2 pm fm 
    Functional_Transformation_BiFunctor F1 F2 T1 T2 U1 U2 D'1 D'2 R'1 R'2 pm' fm'
  unfolding Functional_Transformation_BiFunctor_def atomize_eq Transformation_def Satisfiable_def
  by (clarsimp, smt (verit, best))

paragraph ‹Parameterization›

private lemma φTA_FTFΛ_rule:
  𝗋EIF Ant Ant'
 (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ant'  Transformation_FunctorΛ F1 F2 T U D R mapper)
 (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ant'  Abstract_Domain (F1 T) PT)
 (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ant'  Abstract_Domain (F2 U) PU)
 (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ant'  Object_Equiv (F2 U) eq)
 (𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ant'  𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (f P x y. PT x  PU y  mapper (λp a b. b = f p a  P p a) x y  eq y (fm f P x)  pm f P x))
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 Ant @tag φTA_ANT
 Functional_Transformation_FunctorΛ F1 F2 T U D R pm fm
  unfolding Premise_def Action_Tag_def 𝗋EIF_def
  using infer_FTFΛ_from_FTΛ by blast

private lemma φTA_FTFΛ_deriver_cong:
  D  D'
 (p x. a. a  D' p x  R p x  R' p x)
 (f P x. Satisfiable (x  F1 T)  fm f P x  fm' f P x)
 (f P x. Satisfiable (x  F1 T)  Satisfiable (fm' f P x  F2 U)  pm f P x  pm' f P x)
 Functional_Transformation_FunctorΛ F1 F2 T U D R pm fm 
    Functional_Transformation_FunctorΛ F1 F2 T U D' R' pm' fm'
  unfolding Functional_Transformation_FunctorΛ_def atomize_eq Transformation_def Satisfiable_def
  by (clarsimp, smt (verit, del_insts))


ML_file ‹library/phi_type_algebra/transformation_functor.ML›

end

φproperty_deriver Transformation_Functor 110
    for ( Transformation_Functor _ _ _ _ _ _ _
        | Transformation_BiFunctor _ _ _ _ _ _ _ _ _ _ _
        | Transformation_FunctorΛ _ _ _ _ _ _ _)
  = Phi_Type_Derivers.transformation_functor

φproperty_deriver Functional_Transformation_Functor 111
  for ( Functional_Transformation_Functor _ _ _ _ _ _ _ _
      | Functional_Transformation_BiFunctor _ _ _ _ _ _ _ _ _ _ _ _
      | Functional_Transformation_FunctorΛ _ _ _ _ _ _ _ _)
  requires Transformation_Functor
    = Phi_Type_Derivers.functional_transformation_functor


subsection ‹Separation Homo›

text ‹Note, as an instance of Commutativity of Type Operators, the names of introduction rule›
  and elimination rule› are just reversed. It is intentional, because I really think those names
  are more natural and we don't really have to force the consistency of the names between the two levels.›

context begin

paragraph ‹Normal›

private lemma φTA_SHI_rule:
  (z. Ant 
            (x y. (x,y)  D  w(x,y) = z
                 ((x  OPEN undefined (Fa T)) * (y  OPEN undefined (Fb U))
                    𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z  MAKE undefined (Fc (T  U)))) @tag φTA_subgoal undefined)
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 Ant @tag φTA_ANT
 Separation_HomoI Fa Fb Fc T U D w
  unfolding Separation_HomoI_def φProd_expn' Action_Tag_def MAKE_def OPEN_def
  by simp

private lemma φTA_SHE_rule:
  (z. Ant  
        (z  D 
          (z  OPEN undefined (Fc (T 𝒜 U))
           𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 uz z  NO_SIMP φProd (MAKE undefined (Ft T)) (MAKE undefined (Fu U)))
        ) @tag φTA_subgoal 𝒜simp)
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 Ant @tag φTA_ANT
 Separation_HomoE Ft Fu Fc T U D uz
  unfolding Separation_HomoE_def φProd_expn' Action_Tag_def Bubbling_def MAKE_def OPEN_def NO_SIMP_def
  by simp

private lemma φTA_SHI_rewr_IH:
  Trueprop (Ant  (x y. P x y  ((x  OPEN undefined Ta) * (y  OPEN undefined Tb)
                                      𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z  MAKE undefined Tc)) @tag φTA_subgoal undefined)
 (x y. Ant @tag φTA_ANT  𝗉𝗋𝖾𝗆𝗂𝗌𝖾 P x y  ((x  Ta) * (y  Tb) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z  Tc) @tag φTA_ToA_elim)
  unfolding Action_Tag_def atomize_imp atomize_all Premise_def OPEN_def MAKE_def
  by (rule; blast)

text ‹This conditioned template is necessary because, see,
  prop(x y. (x,y)  D  w(x,y) = z  ((y  Fb U) * (x  Fa T) 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z  Fc (T  U)))
  termz does not determine x› and y› during the reasoning phase and until the phase of proof obligation solving.
  When there are multiple choices of such induction hypotheses, for sure, we can attempt every choice
  exhaustively, but it multiplies the search branches and can harm the performance dramatically.

  Update: perhaps, the conditioned template is not that necessary, because it doesn't really matter
  when x,y› are undetermined, as they are still constrained by conditions given to proof obligations.
  The form of abstract objects should never matter. All syntactic information guiding the reasoning
  should only be given from φ-type, while the syntax of abstract objects shouldn't bear any convention
  nor expectation.

  BTW, I think we have no way to circumvent the reasoning branches even enormous, because there is a
  fallback always varifies the abstract object in the target to a schematic variable.
›

private lemma φTA_SHE_rewr_IH:
  Trueprop (Ant  CC  (z  OPEN undefined T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 uz  MAKE undefined U1  MAKE undefined U2)
            @tag φTA_subgoal A)
 (Ant @tag φTA_ANT  𝗉𝗋𝖾𝗆𝗂𝗌𝖾 CC  z  T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z'  U1  U2 𝗌𝗎𝖻𝗃 z'. z' = uz @tag A)
  unfolding Action_Tag_def atomize_imp atomize_all OPEN_def MAKE_def Premise_def
  by simp

private lemma φTA_SHI_DV_cong:
  D  D'
 z  z'
 Separation_HomoI Ft Fu Fc T U D z  Separation_HomoI Ft Fu Fc T U D' z'
  by simp

private lemma φTA_SHE_DV_cong:
  u  u'
 Separation_HomoE Ft Fu Fc T U D u  Separation_HomoE Ft Fu Fc T U D u'
  by simp

paragraph ‹With Parameterization›

private lemma φTA_SHΛI_rule:
  (z. Ant 
            (x y. (x,y)  D  w(x,y) = z
                 ((x  OPEN undefined (Fa T)) * (y  OPEN undefined (Fb U))
                    𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z  MAKE undefined (Fc (λp. T p  U p))))
            @tag φTA_subgoal undefined)
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 Ant @tag φTA_ANT
 Separation_HomoΛI Fa Fb Fc T U D w
  unfolding Separation_HomoΛI_def φProd_expn' Action_Tag_def MAKE_def OPEN_def
  by simp

private lemma φTA_SHΛE_rule:
  (z. Ant  
        (z  D 
            (z  OPEN undefined (Fc (λp. T p 𝒜 U p))
             𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 uz z  NO_SIMP φProd (MAKE undefined (Ft T)) (MAKE undefined (Fu U))))
          @tag φTA_subgoal 𝒜simp)
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 Ant @tag φTA_ANT
 Separation_HomoΛE Ft Fu Fc T U D uz
  unfolding Separation_HomoΛE_def φProd_expn' Action_Tag_def Bubbling_def
            MAKE_def OPEN_def NO_SIMP_def
  by simp

private lemma φTA_SHΛI_DV_cong:
  D  D'
 z  z'
 Separation_HomoΛI Ft Fu Fc T U D z  Separation_HomoΛI Ft Fu Fc T U D' z'
  by simp

private lemma φTA_SHΛE_DV_cong:
  u  u'
 Separation_HomoΛE Ft Fu Fc T U D u  Separation_HomoΛE Ft Fu Fc T U D u'
  by simp

private lemma φTA_SHE_rewr_pre:
  (Ant  CC (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z  NO_SIMP φProd T U) @tag 𝒜)
 Trueprop (Ant  CC  (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z  T  U) @tag 𝒜)
  unfolding atomize_imp Action_Tag_def NO_SIMP_def .


ML_file ‹library/phi_type_algebra/separation_homo.ML›

end

(*
hide_fact φTA_SHI_rule φTA_SHE_rule φTA_SHI_rewr_IH φTA_SHI_rewr_C
          φTA_SHE_rewr_IH φTA_SHE_rewr_C*)

φproperty_deriver Separation_HomoI 120
  for (Separation_HomoI _ _ _ _ _ _ _ | Separation_HomoΛI _ _ _ _ _ _ _)
    = Phi_Type_Derivers.separation_homo_I

φproperty_deriver Separation_HomoE 121
  for (Separation_HomoE _ _ _ _ _ _ _ | Separation_HomoΛE _ _ _ _ _ _ _)
    = Phi_Type_Derivers.separation_homo_E

φproperty_deriver Separation_Homo 122 requires Separation_HomoI and Separation_HomoE

φproperty_deriver Sep_Functor 130 
  requires Separation_Homo
       and Functional_Transformation_Functor
       and Basic
  ― ‹A separation functor is defined as a transformation functor which is also extendedly commutative
     with separation operator ∗›. The extended commutativity means existing a pair of function z,u› with
     x ⦂ F(T) ∗ F(U) ⟶ z x ⦂ F(T ∗ U)› and y ⦂ F(T ∗ U) ⟶ u y ⦂ F(T) ∗ F(U)› for any x,y›, and it degenerates
     to the usual commutativity when z, u = λx. x›.›

φproperty_deriver Sep_Functor_1 131
  requires Sep_Functor
       and Identity_Elements
       and Identity_Element_Properties


subsection ‹Congruence in Function Definition›

(*TODO: re-implement by template*)

lemma function_congruence_template:
  (𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x = y  (a  D x. T a = U a)  eqs  Transformation_Functor F F' T U D R M)
 (𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x = y  (a  D x. T a = U a)  eqs  Transformation_Functor F' F U T D' R' M')
 (𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x = y  (a  D x. T a = U a)  eqs  Object_Equiv (F' U) eq')
 (𝗉𝗋𝖾𝗆𝗂𝗌𝖾 x = y  (a  D x. T a = U a)  eqs  Object_Equiv (F T) eq)
 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 (x = y  eqs 
              D x  R x  (x y. M (=) x y  eq' y x)  (x. D x = D' x) 
              D' y  R' y  (x y. M' (=) y x  eq x y))
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 eqs
 x = y
 (a. a  D y  T a = U a)
 F T x = F' U y
  unfolding fun_eq_iff[symmetric, where f=D]
  unfolding Transformation_Functor_def Premise_def Transformation_def φType_def BI_eq_iff
            subset_iff meta_Ball_def Ball_def Object_Equiv_def
  apply clarify
  subgoal premises prems for u
    by (insert prems(1)[THEN spec[where x=y], THEN spec[where x=(=)]]
               prems(2)[THEN spec[where x=y], THEN spec[where x=(=)]]
               prems(3-);
        clarsimp; rule; meson) .

(* (*This package is still necessary but I have no good idea to realize it now.
     Maybe I think there should be an ad-hoc deriver maybe?
     The thing is the conditions of the congruence rule cannot be robustly inferred.*)
ML_file ‹library/phi_type_algebra/function_congruence.ML›
*)

subsection ‹Configuration for guessing default Semimodule properties›

definition Guess_Scalar_Zero :: 's itself  'c::one itself  'a itself
                               ('s  ('c,'a) φ)
                               ('s  ('c,'a) φ)
                               's
                               bool  bool
                               bool
  where Guess_Scalar_Zero _ _ _ F unfolded_F zero ants conds  True

definition Guess_Scalar_OneI :: 's itself  'cT itself  'c itself  'aT itself 'a itself
                               ('s  ('c,'a) φ)
                               ('s  ('c,'a) φ)
                               ('cT,'aT) φ
                               ('c,'a1) φ
                               's  ('a1  bool)  ('a1  'a)  ('a1  bool)
                               bool  bool
                               bool
  where Guess_Scalar_OneI _ _ _ _ _ F unfolded_F T T1 one Dx f P ants conds  True

definition Guess_Scalar_OneE :: 's itself  'cT itself  'c itself  'aT itself => 'a itself
                               ('s  ('c,'a) φ)
                               ('s  ('c,'a) φ)
                               ('cT,'aT) φ
                               ('c,'a1) φ
                               's  ('a  bool)  ('a  'a1)  ('a  bool)
                               bool  bool
                               bool
  where Guess_Scalar_OneE _ _ _ _ _ F unfolded_F T T1 one Dx f P ants conds  True

definition Guess_Scalar_AssocI :: 'sc itself  'c itself  'cst itself  'a itself  'ast itself
                                  ('ss  ('ct,'at) φ  ('cst,'as_t) φ)
                                  ('st  ('c,'a) φ  ('ct,'at) φ)
                                  ('sc  ('c,'a) φ  ('cst,'ast) φ)
                                  ('sc  ('c,'a) φ  ('cst,'ast) φ)
                                  ('c,'a) φ
                                  ('ss  bool)
                                  ('st  bool)
                                  ('ss  'st  'as_t  bool)
                                  ('ss  'st  'sc)
                                  ('ss  'st  'as_t  'ast)
                                  bool  bool
                                  bool
  where Guess_Scalar_AssocI _ _ _ _ _ Fs Ft Fc unfolded_Fc T Ds Dt Dx smul f ants conds  True

definition Guess_Scalar_AssocE :: 'sc itself  'c itself  'cst itself  'a itself  'ast itself
                                  ('ss  ('ct,'at) φ  ('cst,'as_t) φ)
                                  ('st  ('c,'a) φ  ('ct,'at) φ)
                                  ('sc  ('c,'a) φ  ('cst,'ast) φ)
                                  ('sc  ('c,'a) φ  ('cst,'ast) φ)
                                  ('c,'a) φ
                                  ('ss  bool)
                                  ('st  bool)
                                  ('ss  'st  'ast  bool)
                                  ('ss  'st  'sc)
                                  ('ss  'st  'ast  'as_t)
                                  bool  bool
                                  bool
  where Guess_Scalar_AssocE _ _ _ _ _ Fs Ft Fc unfolded_Fc T Ds Dt Dx smul f ants conds  True


definition Guess_Zip_of_Semimodule :: 's itself  ('c::sep_magma) itself  'a itself
                                       ('s  ('c,'a) φ)
                                       ('s  ('c,'a) φ)
                                       ('s  bool)
                                       ('s  's  'a × 'a  bool)
                                       ('s  's  'a × 'a  'a)
                                       bool  bool
                                       bool
  where Guess_Zip_of_Semimodule type_scalar type_concrete type_abstract
                                 F unfolded_F_def
                                 domain_of_scalar domain_of_abstract zip_opr
                                 antecedents conditions_of_antecedents
        True

definition Guess_Unzip_of_Semimodule :: 's itself  'c itself  'a itself
                                       ('s  ('c,'a) φ)
                                       ('s  ('c,'a) φ)
                                       ('s  bool)
                                       ('s  's  'a  bool) 
                                       ('s  's  'a  'a × 'a)
                                       bool  bool
                                       bool
  where Guess_Unzip_of_Semimodule type_scalar type_concrete type_abstract
                                   F unfolded_typ_def
                                   domain_of_scalar domain_of_abstract unzip_opr
                                   antecedents conditions_of_antecedents
        True

declare [[ φreason_default_pattern
      (*‹Guess_Scalar_OneI ?S ?C ?AT ?A _ ?def ?T _ _ _› ⇒
      ‹Guess_Scalar_OneI ?S ?C ?AT ?A _ ?def ?T _ _ _›   (100)
  and*)
      Guess_Scalar_Zero ?S ?C ?A _ ?def _ _ _ 
      Guess_Scalar_Zero ?S ?C ?A _ ?def _ _ _   (100)
  and Guess_Scalar_OneI ?S ?CT ?C ?AT ?A _ ?def ?T _ _ _ _ _ _ _ 
      Guess_Scalar_OneI ?S ?CT ?C ?AT ?A _ ?def ?T _ _ _ _ _ _ _   (100)
  and Guess_Scalar_OneE ?S ?CT ?C ?AT ?A _ ?def ?T _ _ _ _ _ _ _ 
      Guess_Scalar_OneE ?S ?CT ?C ?AT ?A _ ?def ?T _ _ _ _ _ _ _   (100)
  and Guess_Zip_of_Semimodule ?S ?C ?A _ ?def _ _ _ _ _ 
      Guess_Zip_of_Semimodule ?S ?C ?A _ ?def _ _ _ _ _   (100)
  and Guess_Unzip_of_Semimodule ?S ?C ?A _ ?def _ _ _ _ _ 
      Guess_Unzip_of_Semimodule ?S ?C ?A _ ?def _ _ _ _ _   (100)
  and Guess_Scalar_AssocI ?S ?CT ?C ?AT ?AF _ _ _ ?def ?T _ _ _ _ _ _ _ 
      Guess_Scalar_AssocI ?S ?CT ?C ?AT ?AF _ _ _ ?def ?T _ _ _ _ _ _ _   (100)
  and Guess_Scalar_AssocE ?S ?CT ?C ?AT ?AF _ _ _ ?def ?T _ _ _ _ _ _ _ 
      Guess_Scalar_AssocE ?S ?CT ?C ?AT ?AF _ _ _ ?def ?T _ _ _ _ _ _ _   (100)
]]

text ‹Guessing the zip operation of a semimodule is far beyond what can be inferred from BNF,
      partially because a semimodule is over two algebraic sorts (i.e., two logical types).
      Due to this, the guessing of the abstract operators of semimodules more relies on pre-registered
      records over the logical types.›

paragraph ‹Initialization›

lemma [φreason %φTA_guesser_init]:
  (s x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_unfolded_F s x) : (x  F s) )
 Guess_Scalar_Zero TS TC TA F var_unfolded_F z ants conds
 Guess_Scalar_Zero TS TC TA F var_unfolded_F z ants conds .

lemma [φreason %φTA_guesser_init]:
  (s x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_unfolded_F s x) : (x  F s) )
 Guess_Scalar_OneI TS TCT TC TAT TA F var_unfolded_F T T1 one Dx f P ants conds
 Guess_Scalar_OneI TS TCT TC TAT TA F var_unfolded_F T T1 one Dx f P ants conds .

lemma [φreason %φTA_guesser_init]:
  (s x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_unfolded_F s x) : (x  F s) )
 Guess_Scalar_OneE TS TCT TC TAT TA F var_unfolded_F T T1 one Dx f P ants conds
 Guess_Scalar_OneE TS TCT TC TAT TA F var_unfolded_F T T1 one Dx f P ants conds .

lemma [φreason %φTA_guesser_init]:
  (s T x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_unfolded_Fc s T x) : (x  Fc s T) )
 Guess_Scalar_AssocI TS TC TC' TAT TA Fs Ft Fc var_unfolded_Fc T Ds Dt Dx smul f ants conds
 Guess_Scalar_AssocI TS TC TC' TAT TA Fs Ft Fc var_unfolded_Fc T Ds Dt Dx smul f ants conds .

lemma [φreason %φTA_guesser_init]:
  (s T x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_unfolded_Fc s T x) : (x  Fc s T) )
 Guess_Scalar_AssocE TS TC TC' TAT TA Fs Ft Fc var_unfolded_Fc T Ds Dt Dx smul f ants conds
 Guess_Scalar_AssocE TS TC TC' TAT TA Fs Ft Fc var_unfolded_Fc T Ds Dt Dx smul f ants conds .

lemma [φreason %φTA_guesser_init]:
  (s x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_unfolded_F s x) : (x  F s) )
 Guess_Zip_of_Semimodule TS TC TA F var_unfolded_F Ds Dx z ants conds
 Guess_Zip_of_Semimodule TS TC TA F var_unfolded_F Ds Dx z ants conds .

lemma [φreason %φTA_guesser_init]:
  (s x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_unfolded_F s x) : (x  F s) )
 Guess_Unzip_of_Semimodule TS TC TA F var_unfolded_F Ds Dx z ants conds
 Guess_Unzip_of_Semimodule TS TC TA F var_unfolded_F Ds Dx z ants conds .


paragraph ‹Guess_Scalar_Zero›

lemma [φreason %φTA_guesser_fallback]:
  Guess_Scalar_Zero TYPE('s::zero) TYPE('c::one) TYPE('a)
                     F unfolded_F 0 True True
  unfolding Guess_Scalar_Zero_def ..

lemma [φreason %φTA_guesser_default]:
  Guess_Scalar_Zero TYPE('s len_intvl) TYPE('c::one) TYPE('a list)
                     F unfolded_F x:0 True True
  unfolding Guess_Scalar_Zero_def ..

paragraph ‹Guess_Scalar_One›

(* lemma [φreason %φTA_guesser_fallback]:
  ‹Guess_Scalar_OneI TYPE('s::one) TYPE('c) TYPE('a) TYPE('a)
                     F whateverT 1 (λ_. True) (λx. x)›
  unfolding Guess_Scalar_OneI_def .. *)

lemma [φreason %φTA_guesser_fallback]:
  Guess_Scalar_OneI TYPE('s::one) TYPE('c) TYPE('c) TYPE('a) TYPE('a)
                     F whatever T T 1 (λ_. True) (λx. x) (λ_. True) True True
  unfolding Guess_Scalar_OneI_def ..

lemma [φreason %φTA_guesser_fallback]:
  Guess_Scalar_OneE TYPE('s::one) TYPE('c) TYPE('c) TYPE('a) TYPE('a)
                     F whatever T T 1 (λ_. True) (λx. x) (λ_. True) True True
  unfolding Guess_Scalar_OneE_def ..

lemma [φreason %φTA_guesser_default]:
  Guess_Scalar_OneI TYPE('s len_intvl) TYPE('c) TYPE('c) TYPE('a) TYPE('a list)
                     F whatever T T x:1 (λ_. True) (λx. [x]) (λ_. True) True True
  unfolding Guess_Scalar_OneI_def ..

lemma [φreason %φTA_guesser_default]:
  Guess_Scalar_OneE TYPE('s len_intvl) TYPE('c) TYPE('c) TYPE('a) TYPE('a list)
                     F whatever T T x:1 (λl. length l = 1) hd (λ_. True) True True
  unfolding Guess_Scalar_OneE_def ..

(* lemma [φreason %φTA_guesser_default]:
  ‹Guess_Scalar_OneI TYPE('i set) TYPE('c::sep_algebra) TYPE('a) TYPE('i ⇒ 'a)
                     F (λs T x. ✱ (A s T x) s) T {any} (λ_. True) (λx _. x) ›
  unfolding Guess_Scalar_OneI_def .. *)

lemma [φreason %φTA_guesser_default]:
  Guess_Scalar_OneI TYPE('i set) TYPE('c) TYPE('c::sep_algebra) TYPE('a) TYPE('i  'a)
                     F (λs x.  (A s x) s) T T {i} (λ_. True) (λx _. x) (λ_. True) True True
  unfolding Guess_Scalar_OneI_def ..

lemma [φreason %φTA_guesser_default]:
  Guess_Scalar_OneE TYPE('i set) TYPE('c) TYPE('c::sep_algebra) TYPE('a) TYPE('i  'a)
                     F (λs x.  (A s x) s) T T {i} (λ_. True) (λf. f i) (λ_. True) True True
  unfolding Guess_Scalar_OneE_def ..


paragraph ‹Guess_Scalar_Assoc›

lemma [φreason %φTA_guesser_default[bottom]]:
  Guess_Scalar_AssocI TYPE('s::times) TYPE('c) TYPE('c) TYPE('a) TYPE('a)
                      F F F whatever T (λ_. True) (λ_. True) (λ_ _ _. True) (*) (λ_ _ x. x) True True
  unfolding Guess_Scalar_AssocI_def ..

lemma [φreason %φTA_guesser_default]:
  Guess_Scalar_AssocI TYPE(rat) TYPE('c::share) TYPE('c) TYPE('a) TYPE('a)
                      F F F whatever T ((<) 0) ((<) 0) (λ_ _ _. True) (*) (λ_ _ x. x) True True
  unfolding Guess_Scalar_AssocI_def ..

lemma [φreason %φTA_guesser_default+1]:
  Guess_Scalar_AssocI TYPE(rat) TYPE('c::share_one) TYPE('c) TYPE('a) TYPE('a)
                      F F F whatever T ((≤) 0) ((≤) 0) (λ_ _ _. True) (*) (λ_ _ x. x) True True
  unfolding Guess_Scalar_AssocI_def ..

lemma [φreason %φTA_guesser_default[bottom]]:
  Guess_Scalar_AssocE TYPE('s::times) TYPE('c) TYPE('c) TYPE('a) TYPE('a)
                      F F F whatever T (λ_. True) (λ_. True) (λ_ _ _. True) (*) (λ_ _ x. x) True True
  unfolding Guess_Scalar_AssocE_def ..

lemma [φreason %φTA_guesser_default]:
  Guess_Scalar_AssocE TYPE(rat) TYPE('c::share) TYPE('c) TYPE('a) TYPE('a)
                      F F F whatever T ((<) 0) ((<) 0) (λ_ _ _. True) (*) (λ_ _ x. x) True True
  unfolding Guess_Scalar_AssocE_def ..

lemma [φreason %φTA_guesser_default+1]:
  Guess_Scalar_AssocE TYPE(rat) TYPE('c::share_one) TYPE('c) TYPE('a) TYPE('a)
                      F F F whatever T ((≤) 0) ((≤) 0) (λ_ _ _. True) (*) (λ_ _ x. x) True True
  unfolding Guess_Scalar_AssocE_def ..

lemma [φreason %φTA_guesser_default for
        Guess_Scalar_AssocI TYPE(_ set) TYPE(_) TYPE(_) TYPE(_) TYPE(_) _ _ _ (λs T x.  (?A s T x) s) _
                            _ _ _ _ _ _ _]:
  Type_Variant_of_the_Same_Scalar_Mul Fc Fs
 Type_Variant_of_the_Same_Scalar_Mul Fc Ft
 Guess_Scalar_AssocI TYPE(('i × 'j) set) TYPE('c::sep_algebra) TYPE('c) TYPE('a) TYPE('i × 'j  'a)
                      Fs Ft Fc (λs T x.  (A s T x) s) T (λ_. True) (λ_. True) (λ_ _ _. True)
                      (×) (λ_ _. case_prod) True True
  unfolding Guess_Scalar_AssocI_def ..

lemma [φreason %φTA_guesser_default for
        Guess_Scalar_AssocE TYPE(_ set) TYPE(_) TYPE(_) TYPE(_) TYPE(_) _ _ _ (λs T x.  (?A s T x) s) _
                            _ _ _ _ _ _ _]:
  Type_Variant_of_the_Same_Scalar_Mul Fc Fs
 Type_Variant_of_the_Same_Scalar_Mul Fc Ft
 Guess_Scalar_AssocE TYPE(('i × 'j) set) TYPE('c::sep_algebra) TYPE('c) TYPE('a) TYPE('i × 'j  'a)
                      Fs Ft Fc (λs T x.  (A s T x) s) T finite finite (λ_ _ _. True)
                      (×) (λ_ _. curry) True True
  unfolding Guess_Scalar_AssocE_def ..


paragraph ‹Guess_(Un)Zip_of_Semimodule›

lemma [φreason %φTA_guesser_default]:
  Guess_Zip_of_Semimodule TYPE(rat) TYPE('c::sep_magma) TYPE('a)
                           F any
                           (λx. 0  x) (λ_ _ (x,y). x = y) (λ_ _ (x,y). x)
                           True True
  unfolding Guess_Zip_of_Semimodule_def ..

lemma [φreason %φTA_guesser_default]:
  Guess_Unzip_of_Semimodule TYPE(rat) TYPE('c::sep_magma) TYPE('a)
                             F any
                             (λx. 0  x) (λ_ _ x. True) (λ_ _ x. (x,x))
                             True True
  unfolding Guess_Unzip_of_Semimodule_def ..

lemma [φreason %φTA_guesser_default]:
  Guess_Zip_of_Semimodule TYPE(nat lcro_intvl) TYPE('c::sep_magma) TYPE('a list)
                           F any (λ_. True)
                           (λs t (x,y). LCRO_Interval.width_of s = length x  LCRO_Interval.width_of t = length y)
                           (λ_ _ (x,y). x @ y)
                           True True
  unfolding Guess_Zip_of_Semimodule_def ..

lemma [φreason %φTA_guesser_default]:
  Guess_Unzip_of_Semimodule TYPE(nat lcro_intvl) TYPE('c::sep_magma) TYPE('a list)
                             F any (λ_. True)
                             (λs t x. LCRO_Interval.width_of s + LCRO_Interval.width_of t = length x)
                             (λs t x. (take (LCRO_Interval.width_of s) x, drop (LCRO_Interval.width_of s) x))
                             True True
  unfolding Guess_Unzip_of_Semimodule_def ..

lemma [φreason %φTA_guesser_default]:
  Guess_Zip_of_Semimodule TYPE('s len_intvl) TYPE('c::sep_magma) TYPE('a list)
                           F any (λ_. True)
                           (λs t (x,y). length x = len_intvl.len s  length y = len_intvl.len t)
                           (λ_ _ (x,y). x @ y)
                           True True
  unfolding Guess_Zip_of_Semimodule_def ..

lemma [φreason %φTA_guesser_default]:
  Guess_Unzip_of_Semimodule TYPE('s len_intvl) TYPE('c::sep_magma) TYPE('a list)
                             F any (λ_. True)
                             (λs t x. length x = len_intvl.len s + len_intvl.len t)
                             (λs t x. (take (len_intvl.len s) x, drop (len_intvl.len s) x))
                             True True
  unfolding Guess_Unzip_of_Semimodule_def ..

lemma [φreason %φTA_guesser_default]:
  Guess_Zip_of_Semimodule TYPE('i set) TYPE('c::sep_algebra) TYPE('i  'a)
                           F (λs x.  (A s x) s)
                           (λ_. True) (λ_ _ _. True) (λ_ Dg (f,g). f f[Dg] g) True True
  unfolding Guess_Zip_of_Semimodule_def ..

lemma [φreason %φTA_guesser_default]:
  Guess_Unzip_of_Semimodule TYPE('i set) TYPE('c::sep_algebra) TYPE('i  'a)
                             F (λs x.  (A s x) s)
                             (λ_. True) (λ_ _ _. True) (λ_ _ f. (f,f)) True True
  unfolding Guess_Unzip_of_Semimodule_def ..


paragraph ‹ML Library›

ML_file ‹library/phi_type_algebra/guess_semimodule.ML›


subsection ‹Semimodule Scalar Zero›

context begin

private lemma φTA_M0_rule:
  (x. Ant  Identity_ElementI (x  OPEN undefined (F zero)) True
                  @tag φTA_subgoal undefined)
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 Ant @tag φTA_ANT
 Module_Zero F zero
  unfolding Module_Zero_def Action_Tag_def Premise_def
            Identity_ElementI_def Identity_ElementE_def OPEN_def
  by (clarsimp simp add: BI_eq_iff Transformation_def; blast)

private lemma φTA_M0c_rule:
  (x. Ant  Identity_ElementE (x  MAKE undefined (F zero))
                  @tag φTA_subgoal undefined)
 Module_Zero F zero
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 Ant @tag φTA_ANT
 Closed_Module_Zero F zero
  unfolding Module_Zero_def Action_Tag_def Premise_def Identity_ElementI_def Identity_ElementE_def
            Closed_Module_Zero_def MAKE_def
  by (clarsimp simp add: BI_eq_iff Transformation_def; blast)

private lemma φTA_M0_rewr_IH:
  Trueprop (Ant  Identity_ElementI (x  OPEN undefined T) True @tag φTA_subgoal A)
  (Ant  Identity_ElementI (x  T) True )
  unfolding Action_Tag_def atomize_imp OPEN_def .

private lemma φTA_M0c_rewr_IH:
  Trueprop (Ant  Identity_ElementE (x  MAKE undefined T) @tag φTA_subgoal A)
  (Ant  Identity_ElementE (x  T) )
  unfolding Action_Tag_def atomize_imp MAKE_def .

ML_file ‹library/phi_type_algebra/Module_Zero.ML›

end

φproperty_deriver Module_Zero 129 for (Module_Zero _ _)
    = Phi_Type_Derivers.Module_Zero

φproperty_deriver Closed_Module_Zero 130
  for (Closed_Module_Zero _ _)
  requires Module_Zero
    = Phi_Type_Derivers.closed_Module_Zero


subsection ‹Semimodule Scalar Identity›

context begin

private lemma φTA_MIE_rule:
  (x. Ant
       𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 D x
       (x  F one 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x  T1 𝗐𝗂𝗍𝗁 PE x) @tag φTA_subgoal undefined)
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 Ant @tag φTA_ANT
 Module_OneE F T1 one D f PE
  unfolding Module_OneE_def Action_Tag_def Premise_def Transformation_def
  by (clarsimp; metis)

private lemma φTA_MII_rule:
  (x. Ant
       𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 D x
       (x  T1 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f x  F one 𝗐𝗂𝗍𝗁 PI x) @tag φTA_subgoal undefined)
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 Ant @tag φTA_ANT
 Module_OneI F T1 one D f PI
  unfolding Module_OneI_def Action_Tag_def Premise_def Transformation_def
  by (clarsimp; metis)

ML_file ‹library/phi_type_algebra/semimodule_identity.ML›

end

φproperty_deriver Module_OneI 130 for (Module_OneI _ _ _ _ _ _)
    = Phi_Type_Derivers.semimodule_identity_I

φproperty_deriver Module_OneE 130 for (Module_OneE _ _ _ _ _ _)
    = Phi_Type_Derivers.semimodule_identity_E

φproperty_deriver Module_One 131
  requires Module_OneI and Module_OneE


subsection ‹Semimodule Scalar Associative›

text ‹φ-type embedding of separation quantifier x ⦂ ✱[i∈I] T› is a recursive example of this.

  The induction of the φ-type should expand the scalar as the scalar usually represents the domain of the φ-type abstraction. 
›

context begin

private lemma φTA_MSI_rule:
  (t s x r y. Ant
          𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ds s  Dt t  Dx s t x  r = smul s t  f s t x = y
          (x  OPEN undefined (Fs s (OPEN undefined (Ft t T)))
             𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  MAKE undefined (Fc r T)) @tag φTA_subgoal undefined)
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 Ant @tag φTA_ANT
 Module_AssocI Fs Ft Fc T Ds Dt Dx smul f
  unfolding Module_AssocI_def Action_Tag_def Premise_def MAKE_def OPEN_def
  by clarsimp

private lemma φTA_MSE_rule:
  (t s r x. Ant
          𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 Ds s  Dt t  r = smul s t  Dx s t x
          (x  OPEN undefined (Fc r T)
             𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 f s t x  MAKE undefined (Fs s (MAKE undefined (Ft t T))))
         @tag φTA_subgoal undefined)
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 Ant @tag φTA_ANT
 Module_AssocE Fs Ft Fc T Ds Dt Dx smul f
  unfolding Module_AssocE_def Action_Tag_def Premise_def MAKE_def OPEN_def
  by clarsimp

private lemma φTA_MSI_rewr_IH:
  Trueprop (Ant  C  (x  OPEN undefined U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  MAKE undefined T 𝗐𝗂𝗍𝗁 P) @tag A)
  (Ant  C  x  U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  φTA_IND_TARGET T 𝗐𝗂𝗍𝗁 P)
  unfolding Action_Tag_def atomize_imp φTA_IND_TARGET_def OPEN_def MAKE_def .


ML_file ‹library/phi_type_algebra/semimodule_scalar.ML›
                            
end

φproperty_deriver Module_AssocI 130 for (Module_AssocI _ _ _ _ _ _ _ _ _)
    = Phi_Type_Derivers.semimodule_assoc_I

φproperty_deriver Module_AssocE 130 for (Module_AssocE _ _ _ _ _ _ _ _ _)
    = Phi_Type_Derivers.semimodule_assoc_E

φproperty_deriver Module_Assoc 131
  requires Module_AssocI and Module_AssocE

φproperty_deriver Semimodule_NonDistr_no0 132
  requires Module_Assoc and Module_One
       and Semimodule_No_SDistr

φproperty_deriver Semimodule_NonDistr 133
  requires Semimodule_NonDistr_no0 and Module_Zero


subsection ‹Semimodule Scalar Distributivity - Zip›

context begin

bundle φTA_MD =
  [[φreason_default_pattern equation21 ?c ?a ?b  equation21 _ _ _ (1000)]]

φreasoner_group 𝒜_partial_add_local = (3850, [3850, 3850]) in 𝒜_partial_add__top ‹›

private lemma φTA_MDZ_rule:
  (s t x r z. Ant
          equation31_cond False True unspec s s t r
          𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds s  Ds t  Dx s t x  zi s t x = z
          (x  NO_SIMP φProd (OPEN undefined (F s)) (OPEN undefined (F t))
             𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 z  MAKE undefined (F r))
         @tag φTA_subgoal undefined)
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 Ant @tag φTA_ANT
 Module_Distr_HomoZ F Ds Dx zi
  unfolding Module_Distr_HomoZ_def Action_Tag_def Premise_def Transformation_def
            OPEN_def MAKE_def NO_SIMP_def equation31_cond_def
  by clarsimp

private lemma φTA_MDU_rule:
  (s t r x. Ant
          equation31_cond False True unspec s s t r
          𝗉𝗋𝖾𝗆𝗂𝗌𝖾 Ds s  Ds t  Dx s t x
          (x  OPEN undefined (F r)
             𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 uz s t x  NO_SIMP φProd (MAKE undefined (F s)) (MAKE undefined (F t)))
        @tag φTA_subgoal (to (𝗍𝗋𝖺𝗏𝖾𝗋𝗌𝖾 𝗉𝖺𝗍𝗍𝖾𝗋𝗇 F r  𝗌𝗉𝗅𝗂𝗍-𝗌𝖼𝖺𝗅𝖺𝗋 s t)))
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 Ant @tag φTA_ANT
 Module_Distr_HomoS F Ds Dx uz
  unfolding Module_Distr_HomoS_def Action_Tag_def Premise_def Transformation_def
            OPEN_def MAKE_def NO_SIMP_def equation31_cond_def
  by clarsimp

private lemma φTA_MDU_cong:
  Ds  Ds'
 (t s x. Ds' t  Ds' s  s ##+ t  Dx  s t x  Dx' s t x)
 (t s x. Ds' t  Ds' s  s ##+ t  Dx' s t x  uz s t x  uz' s t x)
 Module_Distr_HomoS F Ds Dx uz  Module_Distr_HomoS F Ds' Dx' uz'
  unfolding Module_Distr_HomoS_def atomize_eq Transformation_def
  by clarsimp metis

private lemma φTA_MDZ_cong:
  Ds  Ds'
 (t s x. Ds' t  Ds' s  s ##+ t  Dx s t x  Dx' s t x)
 (t s x. Ds' t  Ds' s  s ##+ t  Dx' s t x  z s t x  z' s t x)
 Module_Distr_HomoZ F Ds Dx z  Module_Distr_HomoZ F Ds' Dx' z'
  unfolding Module_Distr_HomoZ_def atomize_eq Transformation_def
  by (auto; metis)

private lemma φTA_MDZ_rewr_IH:
  Trueprop (Ant  C2  C  (x  OPEN undefined U1  OPEN undefined U2
                             𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  MAKE undefined T 𝗐𝗂𝗍𝗁 P) @tag A)
  (Ant @tag φTA_ANT  C2  C  x  U1  U2 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  φTA_IND_TARGET T 𝗐𝗂𝗍𝗁 P @tag φTA_ToA_elim)
  unfolding Action_Tag_def atomize_imp φTA_IND_TARGET_def OPEN_def MAKE_def .

private lemma φTA_MDU_rewr_IH:
  Trueprop (Ant  C2  C  (x  OPEN undefined T
                             𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  MAKE undefined U1  MAKE undefined U2 𝗐𝗂𝗍𝗁 P) @tag φTA_subgoal (to (𝗍𝗋𝖺𝗏𝖾𝗋𝗌𝖾 𝗉𝖺𝗍𝗍𝖾𝗋𝗇 AA  A)))
  (Ant @tag φTA_ANT  C2  C  x  T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  U1  U2 𝗐𝗂𝗍𝗁 P @tag (to A))
  unfolding Action_Tag_def atomize_imp φTA_IND_TARGET_def OPEN_def MAKE_def .

private lemma φTA_MDZ_rewr_pre:
  (Ant  C2  C  x  NO_SIMP φProd T U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P @tag 𝒜)
   Trueprop (Ant  C2  C  (x  T  U 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 Y 𝗐𝗂𝗍𝗁 P) @tag 𝒜)
  unfolding atomize_imp Action_Tag_def NO_SIMP_def .

private lemma φTA_MDU_rewr_pre:
  (Ant  C2  C  X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x  NO_SIMP φProd T U 𝗐𝗂𝗍𝗁 P @tag 𝒜)
   Trueprop (Ant  C2  C  (X 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 x  T  U 𝗐𝗂𝗍𝗁 P) @tag 𝒜)
  unfolding atomize_imp Action_Tag_def NO_SIMP_def .

ML_file ‹library/phi_type_algebra/semimodule_distrib_zip.ML›

end

φproperty_deriver Module_Distr_HomoZ 130 for (Module_Distr_HomoZ _ _ _ _)
    = Phi_Type_Derivers.semimodule_distrib_zip

φproperty_deriver Module_Distr_HomoS 130 for (Module_Distr_HomoS _ _ _ _)
    = Phi_Type_Derivers.semimodule_distrib_unzip

φproperty_deriver Module_Distr_Homo 131
  requires Module_Distr_HomoZ and Module_Distr_HomoS

φproperty_deriver Semimodule_NonAssoc 132
  requires Module_Distr_Homo and Module_Zero
       and Module_One

φproperty_deriver Semimodule_no0 133
  requires Module_Assoc and Module_One
       and Module_Distr_Homo

φproperty_deriver Semimodule 134
  requires Semimodule_no0 and Module_Zero

(*
declare Is_Invariant[where PC=‹Module_Distr_HomoZ›, φreason default %φTA_guesser_assigning_variant]
        Is_Invariant[where PC=‹Module_Distr_HomoS›, φreason default %φTA_guesser_assigning_variant]
*)


subsection ‹Construct Abstraction from Concrete Representation (by Itself)›

(*Designed only for primitives, so can be buggy for advanced and particularly recursive φ-types*)

context begin

private lemma φTA_TrCstr_rule:
  Ant  (c  Itself 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A) @tag φTA_subgoal undefined
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 Ant @tag φTA_ANT
 c  Itself 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 A
  unfolding Action_Tag_def
  by simp

ML_file ‹library/phi_type_algebra/constr_abst_weak.ML›

end

φproperty_deriver Make_Abstraction_from_Raw 130
  for ( x. Premise _ _  (x  Itself 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?f x  ?T)
      | Premise _ _  (?x  Itself 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?y  ?T)
      | x. x  Itself 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?f x  ?T
      | ?x  Itself 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 ?y  ?T )
  requires Warn_if_contains_Sat
    = Phi_Type_Derivers.Make_Abstraction_from_Raw



subsection ‹Destruct Abstraction down to Concrete Representation (by Itself)›

(*Designed only for primitives, so can be buggy for advanced and particularly recursive φ-types*)

context begin

private lemma φTA_TrRA_rule:
  (x. Ant  (x  T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  Itself 𝗌𝗎𝖻𝗃 y. r x y) @tag φTA_subgoal (to (Itself::('b,'b) φ)))
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 Ant @tag φTA_ANT
 x. (x  T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (y::'b)  Itself 𝗌𝗎𝖻𝗃 y. r x y @tag to (Itself::('b,'b) φ))
  unfolding Action_Tag_def
  by simp

private lemma φTA_TrRA_simp:
  x. (x  T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (y::'b)  Itself 𝗌𝗎𝖻𝗃 y. r x y @tag to (Itself::('b,'b) φ))
  Abstract_Domain T P
  (x y. 𝖼𝗈𝗇𝖽𝗂𝗍𝗂𝗈𝗇 P x  𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒 r' x y : r x y )
  x. (x  T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 (y::'b)  Itself 𝗌𝗎𝖻𝗃 y. r' x y @tag to (Itself::('b,'b) φ))
  unfolding Transformation_def Action_Tag_def Satisfiable_def Simplify_def
            Abstract_Domain_def Premise_def 𝗋EIF_def
  by (clarsimp, smt (verit, del_insts))

ML_file ‹library/phi_type_algebra/open_all_abstraction.ML›

end

φproperty_deriver Open_Abstraction_to_Raw 130 for ( x. (x  ?T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  Itself 𝗌𝗎𝖻𝗃 y. ?r x y @tag to Itself)
                                                | x. x  ?T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  Itself 𝗌𝗎𝖻𝗃 y. ?r x y @tag to Itself
                                                | ?x  ?T 𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  Itself 𝗌𝗎𝖻𝗃 y. ?r' y @tag to Itself)
  requires Warn_if_contains_Sat
    = Phi_Type_Derivers.open_all_abstraction

φproperty_deriver Abstraction_to_Raw 131
  requires Open_Abstraction_to_Raw and Make_Abstraction_from_Raw


subsection ‹Trim Empty Generated during Separation Extraction›

(*TODO: reform.*)

text ‹For a type operator F›, SE_Trim_Empty generates rules that eliminates into ○›
  any F ○› generated during Separation Extraction process.

  This elimination is derived from Identity_Element›. If the elimination rule is condition-less
  (demand no conditional premise nor reasoner subgoals), the rule is activated automatically.
  But if there are conditions, the system needs user's discretion to decide if to activate it.
  If so, activate deriver SE_Trim_Empty›.
›

lemma [φreason_template name F.φNone [unfolded Premise_def, assertion_simps, simp]]:
  Type_Variant_of_the_Same_Type_Operator F F'
 TERM (Identity_ElementsI (F ))
 Identity_ElementsI (F ) DI PI @tag 𝒜_template_reason undefined
 Identity_ElementsE (F ) DE @tag 𝒜_template_reason undefined
 Abstract_Domain (F ) PD @tag 𝒜_template_reason undefined
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 (x. (PD x  DI x)  DE x)
 NO_SIMP (F  = )
  unfolding Object_Equiv_def Identity_ElementI_def Identity_ElementE_def NO_SIMP_def Action_Tag_def
            Identity_ElementsI_def Identity_ElementsE_def Premise_def Abstract_Domain_def 𝗋EIF_def
            Satisfiable_def
  apply (rule φType_eqI_Tr; clarsimp simp: Transformation_def)
  by meson

(* Temporarily disabled, and I am thinking if to depreciate this module as it seems useless now.

lemma derive_𝒜SE_trim_I:
  ‹ Type_Variant_of_the_Same_Type_Operator F F'
⟹ Identity_ElementI (yy ⦂ F ○) P
⟹ Object_Equiv (F ○) eq
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 eq (snd y) yy
⟹ 𝒜SE_trimI y (F ○) (fst y, ()) ○ P ›
  unfolding 𝒜SE_trimI_def
  ❴ premises _ and R1[unfolded Identity_ElementI_def]
    apply_rule R1[THEN transformation_right_frame]
  ❵ .

lemma derive_𝒜SE_trim_I_TH:
  ‹ Type_Variant_of_the_Same_Type_Operator F F'
⟹ Identity_ElementI (yy ⦂ F ○) P
⟹ Object_Equiv (F ○) eq
⟹ 𝗉𝗋𝖾𝗆𝗂𝗌𝖾 eq (snd y) yy
⟹ 𝒜SE_trimI_TH y (F ○) (fst y, ()) ○ P ○ (F' ○) ›
  unfolding 𝒜SE_trimI_TH_def
  ❴ premises _ and  R1[unfolded Identity_ElementI_def]
    apply_rule R1[THEN transformation_right_frame]
  ❵ .

lemma derive_𝒜SE_trim_E:
  ‹ Type_Variant_of_the_Same_Type_Operator F F'
⟹ Identity_ElementE (u ⦂ F ○)
⟹ 𝒜SE_trimE (fst x', u) (F ○) x' ○ ›
  unfolding 𝒜SE_trimE_def
  ❴ premises _ and R1[unfolded Identity_ElementE_def]
    apply_rule R1[THEN transformation_right_frame]
  ❵ .

lemma derive_𝒜SE_trim_E_TH:
  ‹ Type_Variant_of_the_Same_Type_Operator F F'
⟹ Identity_ElementE (u ⦂ F ○)
⟹ 𝒜SE_trimE_TH (fst x', u) (F ○) x' ○ ○ (F' ○) ›
  unfolding 𝒜SE_trimE_TH_def
  ❴ premises _ and R1[unfolded Identity_ElementE_def]
    apply_rule R1[THEN transformation_right_frame]
  ❵ .


ML_file ‹library/phi_type_algebra/SE_Trim_Empty.ML›

φproperty_deriver SE_Trim_Empty 110
    = ‹fn quiet => K (Phi_Type_Derivers.SE_Trim_Empty quiet) ›

lemmas [φreason_template default 40 pass: ‹(Phi_Type_Derivers.SE_Trim_Empty__generation_pass, K I)›] =
          derive_𝒜SE_trim_I derive_𝒜SE_trim_I_TH
          derive_𝒜SE_trim_E derive_𝒜SE_trim_E_TH
*)

subsection ‹Meta Deriver for φ-Type Operator Commutativity›

paragraph ‹Guess Property›

subparagraph ‹Definition of Reasoning Goals›

definition Guess_Tyops_Commute :: bool ― ‹Intro for true, Elim for false›
                                 (('cF,'aF) φ  ('c,'a) φ)
                                 (('cT,'aT) φ  ('cG,'aG) φ)
                                 (('cT,'aT) φ  ('cF,'aF) φ)
                                 (('cG,'aG) φ  ('c,'b) φ)
                                 (('cF,'aF) φ  ('c,'a) φ)
                                 (('cT,'aT) φ  ('cG,'aG) φ)
                                 (('cT,'aT) φ  ('cF,'aF) φ)
                                 (('cG,'aG) φ  ('c,'b) φ)
                                 ('cT,'aT) φ
                                 ('a  bool)
                                 ('a  'b  bool)
                                 bool  bool
                                 bool
  where Guess_Tyops_Commute is_intro G G' F F' unfolded_G unfolded_G' uF uF' T D r ants conds  True

definition Guess_Tyops_Commute1_2 :: bool ― ‹True for 1→2I›, False for 2→1I›
                                     (('cG,'aG) φ  ('c,'a) φ)
                                     (('cT,'aT) φ  ('cFT,'aFT) φ)
                                     (('cU,'aU) φ  ('cFU,'aFU) φ)
                                     (('cT,'aT) φ  ('cU,'aU) φ  ('cG,'aG) φ)
                                     (('cFT,'aFT) φ  ('cFU,'aFU) φ  ('c,'b) φ)
                                     (('cG,'aG) φ  ('c,'a) φ)
                                     (('cT,'aT) φ  ('cFT,'aFT) φ)
                                     (('cU,'aU) φ  ('cFU,'aFU) φ)
                                     (('cT,'aT) φ  ('cU,'aU) φ  ('cG,'aG) φ)
                                     (('cFT,'aFT) φ  ('cFU,'aFU) φ  ('c,'b) φ)
                                     ('cT,'aT) φ
                                     ('cU,'aU) φ
                                     ('b  bool)
                                     ('b  'a  bool)
                                     bool  bool
                                     bool
  where Guess_Tyops_Commute1_2 mode F F'T F'U G G' uF uF'T uF'U uG uG' T U D r ants conds  True
    ― ‹also covers Guess_Tyops_Commute2_1I, by swapping F› and G›

definition Guess_Tyops_Commute2_1 :: bool ― ‹True for 1→2E›, False for 2→1E›
                                    (('cG,'aG) φ  ('c,'a) φ)
                                    (('cT,'aT) φ  ('cFT,'aFT) φ)
                                    (('cU,'aU) φ  ('cFU,'aFU) φ)
                                    (('cT,'aT) φ  ('cU,'aU) φ  ('cG,'aG) φ)
                                    (('cFT,'aFT) φ  ('cFU,'aFU) φ  ('c,'b) φ)
                                    (('cG,'aG) φ  ('c,'a) φ)
                                    (('cT,'aT) φ  ('cFT,'aFT) φ)
                                    (('cU,'aU) φ  ('cFU,'aFU) φ)
                                    (('cT,'aT) φ  ('cU,'aU) φ  ('cG,'aG) φ)
                                    (('cFT,'aFT) φ  ('cFU,'aFU) φ  ('c,'b) φ)
                                    ('cT,'aT) φ
                                    ('cU,'aU) φ
                                    ('a  bool)
                                    ('a  'b  bool)
                                    bool  bool
                                    bool
  where Guess_Tyops_Commute2_1 mode F F'T F'U G G' uF uF'T uF'G uG uG' T U D r ants conds  True


φreasoner_group guess_tyop_commute_all = (100,[10,3000]) for (Guess_Tyops_Commute intro F F' G G' unfolded_G unfolded_G' uF uF' T D r ants conds)
    ‹Rules guessing the form of the Commutativity between φ-Type Operators›
 and guess_tyop_commute = (1000, [1000, 3000]) for (Guess_Tyops_Commute intro F F' G G' unfolded_G unfolded_G' uF uF' T D r ants conds)
                                             in guess_tyop_commute_all
    ‹User Rules›
 and guess_tyop_commute_fallback = (10, [10,10]) for (Guess_Tyops_Commute intro F F' G G' unfolded_G unfolded_G' uF uF' T D r ants conds)
                                                  in guess_tyop_commute_all < guess_tyop_commute
    ‹Fallback rules›
 and guess_tyop_commute_default = (15, [11, 39]) for (Guess_Tyops_Commute intro F F' G G' unfolded_G unfolded_G' uF uF' T D r ants conds)
                                                  in guess_tyop_commute_all and > guess_tyop_commute_fallback and < guess_tyop_commute
    ‹Predefined default rules guessing the form of the Commutativity between φ-Type Operators›

declare [[
  φreason_default_pattern Guess_Tyops_Commute ?mode ?F _ ?G _ ?uG ?uG' ?uF ?uF' _ _ _ _ _ 
                          Guess_Tyops_Commute ?mode ?F _ ?G _ ?uG ?uG' ?uF ?uF' _ _ _ _ _    (100)
                      and Guess_Tyops_Commute1_2 ?mode ?F _ _ ?G _ ?uF ?uFT ?uFF ?uG ?uG' _ _ _ _ _ _ 
                          Guess_Tyops_Commute1_2 ?mode ?F _ _ ?G _ ?uF ?uFT ?uFF ?uG ?uG' _ _ _ _ _ _    (100)
                      and Guess_Tyops_Commute2_1 ?mode ?G _ _ ?F _ ?uG ?uGT ?uGF ?uF ?uF' _ _ _ _ _ _ 
                          Guess_Tyops_Commute2_1 ?mode ?G _ _ ?F _ ?uG ?uGT ?uGF ?uF ?uF' _ _ _ _ _ _    (100)
]]

subparagraph ‹Initialization›

lemma [φreason %guess_tyop_commute_default for Guess_Tyops_Commute _ _ ?var_F' _ _ _ _ _ _ _ _ _ _ _]:
  Parameter_Variant_of_the_Same_Type F var_F'
 Guess_Tyops_Commute Any F var_F' G G' uF uF' uG uG' T D r ants conds
 Guess_Tyops_Commute Any F var_F' G G' uF uF' uG uG' T D r ants conds .

lemma [φreason %guess_tyop_commute_default for Guess_Tyops_Commute _ _ _ _ ?var_G' _ _ _ _ _ _ _ _ _]:
  Parameter_Variant_of_the_Same_Type G var_G'
 Guess_Tyops_Commute Any F F' G var_G' uF uF' uG uG' T D r ants conds
 Guess_Tyops_Commute Any F F' G var_G' uF uF' uG uG' T D r ants conds .

lemma [φreason %φTA_guesser_init except Guess_Tyops_Commute True _ _ _ ?var_F' _ _ _ _ _ _ _ _ _
                                         Guess_Tyops_Commute True _ ?var_G' _ _ _ _ _ _ _ _ _ _ _]:
  (T x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_unfolded_G T x) : (x  G T) )
 (T x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_unfolded_G' T x) : (x  G' T) )
 Guess_Tyops_Commute True G G' F F' var_unfolded_G var_unfolded_G' uF uF' T D r ants conds
 Guess_Tyops_Commute True G G' F F' var_unfolded_G var_unfolded_G' uF uF' T D r ants conds .

lemma [φreason %φTA_guesser_init except Guess_Tyops_Commute False _ _ _ ?var_G' _ _ _ _ _ _ _ _ _
                                        Guess_Tyops_Commute False _ ?var_F' _ _ _ _ _ _ _ _ _ _ _]:
  (T x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_unfolded_G T x) : (x  G T) )
 (T x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_unfolded_G' T x) : (x  G' T) )
 Guess_Tyops_Commute False F F' G G' uF uF' var_unfolded_G var_unfolded_G' T D r ants conds
 Guess_Tyops_Commute False F F' G G' uF uF' var_unfolded_G var_unfolded_G' T D r ants conds .

lemma [φreason %φTA_guesser_init]:
  Parameter_Variant_of_the_Same_Type F F'T
 Parameter_Variant_of_the_Same_Type F F'U
 Parameter_Variant_of_the_Same_Type G G'
 (T U x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_unfolded_G T U x) : (x  G T U) )
 (T U x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_unfolded_G' T U x) : (x  G' T U) )
 Guess_Tyops_Commute1_2 True F F'T F'U G G' uF uF'T uF'U var_unfolded_G var_unfolded_G' T U D r ants conds
 Guess_Tyops_Commute1_2 True F F'T F'U G G' uF uF'T uF'U var_unfolded_G var_unfolded_G' T U D r ants conds .

lemma [φreason %φTA_guesser_init]:
  Parameter_Variant_of_the_Same_Type F F'
 Parameter_Variant_of_the_Same_Type G G'T
 Parameter_Variant_of_the_Same_Type G G'U
 (T x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_unfolded_G T x) : (x  G T) )
 (T x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_unfolded_G'T T x) : (x  G'T T) )
 (T x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_unfolded_G'U T x) : (x  G'U T) )
 Guess_Tyops_Commute1_2 False G G'T G'U F F' var_unfolded_G var_unfolded_G'T var_unfolded_G'U uF uF' T U D r ants conds
 Guess_Tyops_Commute1_2 False G G'T G'U F F' var_unfolded_G var_unfolded_G'T var_unfolded_G'U uF uF' T U D r ants conds .


lemma [φreason %φTA_guesser_init]:
  Parameter_Variant_of_the_Same_Type F F'T
 Parameter_Variant_of_the_Same_Type F F'U
 Parameter_Variant_of_the_Same_Type G G'
 (T U x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_uG T U x) : (x  G T U) )
 (T U x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_uG' T U x) : (x  G' T U) )
 Guess_Tyops_Commute2_1 True F F'T F'U G G' uF uF'T uF'U var_uG var_uG' T U D r ants conds
 Guess_Tyops_Commute2_1 True F F'T F'U G G' uF uF'T uF'U var_uG var_uG' T U D r ants conds .

lemma [φreason %φTA_guesser_init]:
  Parameter_Variant_of_the_Same_Type F F'
 Parameter_Variant_of_the_Same_Type G G'T
 Parameter_Variant_of_the_Same_Type G G'U
 (T x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_uG T x) : (x  G T) )
 (T x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_uG'T T x) : (x  G'T T) )
 (T x. 𝗌𝗂𝗆𝗉𝗅𝗂𝖿𝗒[φderiver_expansion] (var_uG'U T x) : (x  G'U T) )
 Guess_Tyops_Commute2_1 False G G'T G'U F F' var_uG var_uG'T var_uG'U uF uF' T U D r ants conds
 Guess_Tyops_Commute2_1 False G G'T G'U F F' var_uG var_uG'T var_uG'U uF uF' T U D r ants conds .


subparagraph ‹Default Rules›

lemma [φreason %guess_tyop_commute_fallback for Guess_Tyops_Commute _ _ _ _ _ _ _ _ _ _ _ _ _ _]:
  Type_Variant_of_the_Same_Type_Operator F F' cut True
 Type_Variant_of_the_Same_Type_Operator G G' cut True
 Guess_Tyops_Commute both F F' G G' uF uF' any any' T (λ_. True) (embedded_func (λx. x) (λ_. True)) True True
  unfolding Guess_Tyops_Commute_def ..

lemma [φreason %guess_tyop_commute_fallback for Guess_Tyops_Commute2_1 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _]:
  Type_Variant_of_the_Same_Type_Operator2 F F' cut True
 Type_Variant_of_the_Same_Type_Operator G G'T cut True
 Type_Variant_of_the_Same_Type_Operator G G'U cut True
 Guess_Tyops_Commute2_1 both G G'T G'U F F' uG uG'T uG'U uF uF' T U
                          (λ_. True) (embedded_func (λx. x) (λ_. True)) True True
  unfolding Guess_Tyops_Commute2_1_def ..

lemma [φreason %guess_tyop_commute_fallback for Guess_Tyops_Commute1_2 _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _]:
  Type_Variant_of_the_Same_Type_Operator2 G G' cut True
 Type_Variant_of_the_Same_Type_Operator F F'T cut True
 Type_Variant_of_the_Same_Type_Operator F F'U cut True
 Guess_Tyops_Commute1_2 both F F'T F'U G G' uF uF'T uF'U uG uG' T U
                               (λ_. True) (embedded_func (λx. x) (λ_. True)) True True
  unfolding Guess_Tyops_Commute1_2_def ..


subparagraph ‹ML›

ML_file ‹library/phi_type_algebra/guess_tyops_commute.ML›


subparagraph ‹Templates›

context begin

private lemma Guess_Tyops_Commute_by_unfolding_1:
  (T x. A T x = A' T x)
 Guess_Tyops_Commute mode G G' F F' uG uG' A' uF' T D R a c
 Guess_Tyops_Commute mode G G' F F' uG uG' A  uF' T D R a c
  by presburger

private lemma Guess_Tyops_Commute_by_unfolding_2:
  (T x. A T x = A' T x)
 Guess_Tyops_Commute mode G G' F F' uG uG' uF A' T D R a c
 Guess_Tyops_Commute mode G G' F F' uG uG' uF A  T D R a c
  by presburger

private lemma Guess_Tyops_Commute_by_unfolding_3:
  (T x. A T x = A' T x)
 Guess_Tyops_Commute mode G G' F F' A' uG' uF uF' T D R a c
 Guess_Tyops_Commute mode G G' F F' A  uG' uF uF' T D R a c
  by presburger

private lemma Guess_Tyops_Commute_by_unfolding_4:
  (T x. A T x = A' T x)
 Guess_Tyops_Commute mode G G' F F' uG A' uF uF' T D R a c
 Guess_Tyops_Commute mode G G' F F' uG A  uF uF' T D R a c
  by presburger+

lemmas Guess_Tyops_Commute_by_unfolding =
          Guess_Tyops_Commute_by_unfolding_1 Guess_Tyops_Commute_by_unfolding_2
          Guess_Tyops_Commute_by_unfolding_3 Guess_Tyops_Commute_by_unfolding_4

end


subparagraph ‹Deriving Bubbling ToA›



(*
subparagraph ‹Rules›

lemma [φreason %object_equiv_cut]:
  ‹ Object_Equiv T eq
⟹ Object_Equiv (𝗁𝖺𝗌-𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 T) eq›
  unfolding Has_Bubbling_def .

lemma [φreason %object_equiv_cut]:
  ‹ Object_Equiv T eq
⟹ Object_Equiv (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 T) eq›
  unfolding Bubbling_def .

lemma [φreason %identity_element_cut]:
  ‹ Identity_ElementsI T D P
⟹ Identity_ElementsI (𝗁𝖺𝗌-𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 T) D P ›
  unfolding Has_Bubbling_def .

lemma [φreason %identity_element_cut]:
  ‹ Identity_ElementsE T D
⟹ Identity_ElementsE (𝗁𝖺𝗌-𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 T) D ›
  unfolding Has_Bubbling_def .
*)

paragraph ‹Deriver›

φreasoner_group derived_commutativity_deriver = (150, [150, 151 ]) for _
    ‹The priority of derived deriver for commutativity between type operators›

(*F is fixed myself, G is the target
  Given ‹F›, generate derivers deriving ‹Tyops_Commute F F' G G' T D r›
  and ‹Tyops_Commute G G' F F' T D r› for given G
*)

lemma φTA_TyCommI_gen:
  Parameter_Variant_of_the_Same_Type F F'
 𝗋Success ―‹Success of generating deriving rule›
 (x. Ant 
          𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x 
          (x  OPEN undefined (G (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F T))
          𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  F' (MAKE undefined (G' T)) 𝗌𝗎𝖻𝗃 y. r x y)
        @tag φTA_subgoal 𝒜simp)
          ―‹^ target of inductive expansion, needs to (𝖼𝗈𝗆𝗆𝗎𝗍𝖾 G F)›
          ―‹The OPEN› tag restricts the deriver to only unfold what should be unfolded,
             especially when reasoning the commutativity between one φ-type and itself.›
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 Ant @tag φTA_ANT
 Tyops_Commute G G' F F' T D r
  unfolding Action_Tag_def Tyops_Commute_def Premise_def Bubbling_def MAKE_def OPEN_def
  by blast

lemma φTA_TyCommE_gen:
  Parameter_Variant_of_the_Same_Type F F'
 𝗋Success ―‹Success of generating deriving rule›
 (x. Ant 
          𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x 
           (x  𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F (OPEN undefined (G T))
            𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  MAKE undefined (G' (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F' T)) 𝗌𝗎𝖻𝗃 y. r x y)
        @tag φTA_subgoal undefined)
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 Ant @tag φTA_ANT
 Tyops_Commute F F' G G' T D r
  unfolding Action_Tag_def Tyops_Commute_def Premise_def embedded_func_def Bubbling_def OPEN_def MAKE_def
  by clarsimp
  

lemma φTA_TyComm1_2I_gen:
  Parameter_Variant_of_the_Same_Type F F'T
 Parameter_Variant_of_the_Same_Type F F'U
 𝗋Success ―‹Success of generating deriving rule›
 (x. Ant 
          𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x 
          (x  OPEN undefined (G' (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F'T T) (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F'U U))
           𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  F (MAKE undefined (G T U)) 𝗌𝗎𝖻𝗃 y. r x y)
        @tag φTA_subgoal 𝒜simp)
          ―‹^ target of inductive expansion, needs to (𝖼𝗈𝗆𝗆𝗎𝗍𝖾 G F)›
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 Ant @tag φTA_ANT
 Tyops_Commute2_1 F F'T F'U G G' T U D r
  unfolding Action_Tag_def Tyops_Commute2_1_def Premise_def Bubbling_def OPEN_def MAKE_def
  by blast

lemma φTA_TyComm1_2E_gen:
  Parameter_Variant_of_the_Same_Type F F'T
 Parameter_Variant_of_the_Same_Type F F'U
 𝗋Success ―‹Success of generating deriving rule›
 (x. Ant 
       𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x 
        (x  𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F (OPEN undefined (G T U))
         𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  MAKE undefined (G' (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F'T T) (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F'U U)) 𝗌𝗎𝖻𝗃 y. r x y)
                      ―‹^ target of inductive expansion. The same limitation as above.›
       @tag φTA_subgoal undefined)
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 Ant @tag φTA_ANT
 Tyops_Commute1_2 F F'T F'U G G' T U D r
  unfolding Action_Tag_def Tyops_Commute1_2_def Premise_def embedded_func_def OPEN_def MAKE_def Bubbling_def
  by clarsimp

lemma φTA_TyComm2_1I_gen:
  Parameter_Variant_of_the_Same_Type F F'
 𝗋Success ―‹Success of generating deriving rule›
 (x. Ant 
          𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x 
          (x  OPEN undefined (G (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F T U))
            ―‹^ target of inductive expansion, needs to (𝖼𝗈𝗆𝗆𝗎𝗍𝖾 G F)›
           𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  F' (MAKE undefined (G'T T)) (MAKE undefined (G'U U)) 𝗌𝗎𝖻𝗃 y. r x y)
        @tag φTA_subgoal 𝒜simp)
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 Ant @tag φTA_ANT
 Tyops_Commute1_2 G G'T G'U F F' T U D r
  unfolding Action_Tag_def Tyops_Commute1_2_def Premise_def Bubbling_def OPEN_def MAKE_def
  by clarsimp

lemma φTA_TyComm2_1E_gen:
  Parameter_Variant_of_the_Same_Type F F'
 𝗋Success ―‹Success of generating deriving rule›
 (x. Ant 
       𝗉𝗋𝖾𝗆𝗂𝗌𝖾 D x 
        (x  𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F' (OPEN undefined (G'T T)) (OPEN undefined (G'U U))
         𝗍𝗋𝖺𝗇𝗌𝖿𝗈𝗋𝗆𝗌 y  MAKE undefined (G (𝖻𝗎𝖻𝖻𝗅𝗂𝗇𝗀 F T U)) 𝗌𝗎𝖻𝗃 y. r x y)
                     ―‹^ target of inductive expansion. The same limitation as above.›
       @tag φTA_subgoal undefined)
 𝗋Success
 𝗈𝖻𝗅𝗂𝗀𝖺𝗍𝗂𝗈𝗇 True
 Ant @tag φTA_ANT
 Tyops_Commute2_1 G G'T G'U F F' T U D r
  unfolding Action_Tag_def Tyops_Commute2_1_def Premise_def embedded_func_def OPEN_def MAKE_def Bubbling_def
  by clarsimp

(*TODO: bi-commutativity!*)

ML_file ‹library/phi_type_algebra/gen_tyops_commute.ML›

φproperty_deriver Commutativity_DeriverI 200
    = fn quiet => K (Phi_Type_Derivers.meta_Tyops_Commute (false, 1) quiet)

φproperty_deriver Commutativity_DeriverE 200
    = fn quiet => K (Phi_Type_Derivers.meta_Tyops_Commute (false, 2) quiet)

φproperty_deriver Commutativity_Deriver 200
    = fn quiet => K (Phi_Type_Derivers.meta_Tyops_Commute (false, 3) quiet)

φproperty_deriver Commutativity_DeriverI_rev 200
    = fn quiet => K (Phi_Type_Derivers.meta_Tyops_Commute (true, 2) quiet)
  ― ‹The name is reversed, i.e., I for E, E for I, but the deriving process is unchanged.›

φproperty_deriver Commutativity_DeriverE_rev 200
    = fn quiet => K (Phi_Type_Derivers.meta_Tyops_Commute (true, 1) quiet)

φproperty_deriver Commutativity_Deriver_rev 200
    = fn quiet => K (Phi_Type_Derivers.meta_Tyops_Commute (true, 3) quiet)



section ‹Deriving Configures for Specific Abstract Algebras›

subsubsection ‹Common›

lemmas [φderiver_simps] =
  Nat.add_Suc_right Groups.monoid_add_class.add.right_neutral Nat.nat.inject

lemmas [φderiver_simps] =
  Basic_BNFs.prod_set_defs

declare option.rel_eq[iff] option.pred_True[iff]

subsubsection ‹List›

declare list.rel_eq[iff] list.pred_True[iff]

(*definition ‹zip' = case_prod zip›*)
setup Sign.mandatory_path "list"
abbreviation unzip l  (map fst l, map snd l)

lemma case_unzip[simp]:
  (case list.unzip x of (a,b)  f a b) = (let a = map fst x; b = map snd x in f a b)
  by simp

(*deprecated
lemma zip'_inj[iff]:
  ‹length (fst l) = length (snd l) ⟹ map fst (zip' l) = fst l›
  ‹length (fst l) = length (snd l) ⟹ map snd (zip' l) = snd l›
  unfolding zip'_def
  by (cases l; simp)+*)

lemma zip_unzip[iff]:
  case_prod zip (list.unzip l) = l
  by (simp add: zip_map_fst_snd)

lemma unzip_zip[iff]:
  length x = length y
 list.unzip (zip x y) = (x,y)
  by simp

lemma zip_eq_Cons_ex:
  zip x y = (h#l)  (ah al bh bl. x = ah # al  y = bh # bl  (ah,bh) = h  zip al bl = l)
  by (simp, induct_tac y; case_tac x; simp)

lemma zip_eq_Nil_eq_len:
  length x = length y  (zip x y = [])  x = []  y = []
  by (simp; induct x; cases y; simp)

lemma zip_eq_Nil_with_rel:
  list_all2 P a b  zip a b = []  a = []  b = []
  by (induct b; cases a; simp)

setup Sign.parent_path


lemma map_prod_case_analysis:
  map (λx. (f x, g x)) la = lb  map f la = map fst lb  map g la = map snd lb
  by (induct la arbitrary: lb; clarsimp; fastforce)

lemma list_all2__const_True[simp]:
  list_all2 (λx y. True) = (λx y. length x = length y)
  apply (clarsimp simp add: fun_eq_iff)
  subgoal for x y
  by (induct x arbitrary: y; simp; case_tac y; simp) .

(*
setup ‹ Context.theory_map(
  BNF_FP_Sugar_More.add_fp_more (type_name‹list›, {
      deads = [],
      lives = [typ‹'a›],
      lives'= [typ‹'b›],
      zip = term‹zip'›,
      unzip = Const‹unzip' typ‹'a› typ‹'b››,
      zip_simps = @{thms' zip'_inj zip'_eq_Cons_ex zip'_eq_Cons_ex zip'_eq_Nil_eq_len
                          length_map length_zip' zip'_map
                          unzip'_inj unzip'_prj map_prod_case_analysis}
  }))
›
*)

term list.unzip :: ('a × 'b) list  'a list × 'b list

setup Context.theory_map(
  BNF_FP_Sugar_More.add_fp_more (type_namelist, {
      deads = [],
      lives = [typ'a],
      lives'= [typ'b],
      zip = termcase_prod zip :: 'a list × 'b list  ('a × 'b) list,
      unzip = termlist.unzip :: ('a × 'b) list  'a list × 'b list,
      zip_simps = @{thms' list.zip_unzip list.unzip_zip list.zip_eq_Cons_ex list.zip_eq_Nil_eq_len
                          length_map length_zip zip_map1 zip_map2 zip_map_fst_snd
                          List.zip_map_fst_snd map_zip_map map_zip_map2
                          map_prod_case_analysis}
  }))

lemma list_all2_reduct_rel[simp]:
  list_all2 (λa b. b = f a  P a) = (λa' b'. b' = map f a'  list_all P a')
  apply (clarsimp simp add: fun_eq_iff)
  subgoal for x y by (induct x arbitrary: y; simp; case_tac y; simp; blast) .

lemmas [φderiver_simps] =
  list.size map_eq_Cons_conv list_all2_lengthD[THEN HOL.Eq_TrueI]

paragraph ‹Separatable Mappers›

lemma [φreason add]:
  compositional_mapper map map map UNIV f g
  unfolding compositional_mapper_def
  by clarsimp

lemma [φreason add]:
  separatable_unzip (case_prod zip) list.unzip UNIV map map map f g
  unfolding separatable_unzip_def
  by (clarsimp simp add: zip_eq_conv)

lemma [φreason add]:
  separatable_zip list.unzip (case_prod zip) {(la,lb). length la = length lb} map map map f g
  unfolding separatable_zip_def
  by (clarsimp simp add: zip_eq_conv, metis map_fst_zip map_map map_snd_zip)

lemma [φreason add]:
  domain_by_mapper set map set f UNIV
  unfolding domain_by_mapper_def
  by clarsimp

lemma [φreason add]:
  domain_of_inner_map map set
  unfolding domain_of_inner_map_def
  by clarsimp


subsubsection ‹Sum›

lemma pred_sum_eq_case_sum[φderiver_simps]:
  pred_sum P Q x  case_sum P Q x
  by (cases x; simp)

lemma collapse_case_sum[simp]:
  (case x of Inl x  Inl x | Inr x  Inr x) = x
  by (cases x; simp)


subsubsection ‹Set›

(*definition ‹zip_set = case_prod (×)›
definition ‹unzip_set s = (Domain s, Range s)› *)

lemma rel_set__const_True[simp]:
  rel_set (λx y. True) = (λx y. x = {}  y = {})
  by (clarsimp simp add: fun_eq_iff rel_set_def; blast)

setup Context.theory_map (eBNF_Info.add_BNF (type_nameSet.set, 
let val a = TFree ("a", sorttype)
    val b = TFree ("b", sorttype)
 in {
  T = TypeSet.set a,
  Tname = type_nameSet.set,
  casex = NONE,
  case_distribs = [],
  ctrs = [Constbot Typeset a, Constinsert a, Constsup Typeset a],
  deads = [], lives = [a], lives'= [b],
  sets = [Abs("x", TypeSet.set a, Bound 0)],
  set_thms = [],
  ctr_simps = [],
  rel = Constrel_set a b,
  rel_simps = @{thms' Lifting_Set.empty_transfer rel_set__const_True},
  rel_eq = @{thm' rel_set_eq},
  pred = Abs("P", a --> HOLogic.boolT, Abs ("S", TypeSet.set a, ConstBall a $ Bound 0 $ Bound 1)),
  pred_injects = @{thms' Set.ball_simps(5) Set.ball_Un Set.ball_simps(7)},
  pred_simps = @{thms' Set.ball_simps},
  map = ConstSet.image a b,
  map_thms = @{thms' Set.image_insert Set.image_Un Set.image_empty},
  map_disc_iffs = @{thms' image_is_empty},
  map_ident = @{thm' Set.image_ident},
  map_comp_of = @{thm' Set.image_image},
  fp_more = SOME {
    deads = [],
    lives = [a],
    lives'= [b],
    zip = termcase_prod (×) :: 'a set × 'b set  ('a × 'b) set,
    unzip = term(λs. (Domain s, Range s)) :: ('a × 'b) set  'a set × 'b set,
    zip_simps = []
  }
} end)
)


lemmas [φderiver_simps] =
  Set.ball_Un Fun.bind_image Set.empty_bind Set.bind_singleton_conv_image
  Set.nonempty_bind_const Finite_Set.finite_bind

lemma Set_bind_insert[simp, φderiver_simps]:
  Set.bind (insert x S) f = f x  Set.bind S f
  unfolding Set.bind_def
  by auto


subsubsection ‹Function›

definition zip_fun = case_prod BNF_Def.convol
definition unzip_fun f = (fst o f, snd o f)

lemma zip_fun_inj[simp]:
  fst o (zip_fun f) = fst f
  snd o (zip_fun f) = snd f
  unfolding zip_fun_def fun_eq_iff BNF_Def.convol_def
  by (cases f; clarsimp)+

lemma zip_fun_inj'[simp]:
  fst (zip_fun f x) = fst f x
  snd (zip_fun f x) = snd f x
  unfolding zip_fun_def fun_eq_iff BNF_Def.convol_def
  by (cases f; clarsimp)+

lemma zip_fun_map:
  zip_fun (f o x, y) = apfst f o zip_fun (x, y)
  zip_fun (x, g o y) = apsnd g o zip_fun (x, y)
  unfolding zip_fun_def BNF_Def.convol_def
  by clarsimp+

lemma zip_fun_prj[simp]:
  fst (unzip_fun x) = fst o x
  snd (unzip_fun x) = snd o x
  unfolding unzip_fun_def
  by clarsimp+

lemma map_fun_prod_case_analysis:
  (λx. (f x, g x)) o a = b  f o a = fst o b  g o a = snd o b
  unfolding atomize_eq fun_eq_iff
  by (clarsimp, rule, metis fst_eqD snd_conv, clarsimp)

setup Context.theory_map(
  let val (i, a, b) = (typ'i, typ'a, typ'b)
   in BNF_FP_Sugar_More.add_fp_more (type_namefun, {
        deads = [i], lives = [a], lives'= [b],
        zip = Constzip_fun i a b,
        unzip = Constunzip_fun i a b,
        zip_simps = @{thms' zip_fun_inj zip_fun_inj' zip_fun_map zip_fun_prj map_fun_prod_case_analysis}
  }) end)

lemma rel_fun__const_True[simp]:
  rel_fun (=) (λx y. True) = (λx y. True)
  by (simp add: fun_eq_iff rel_fun_def)

subsubsection ‹Option›

setup Context.theory_map(
  let val (a, b) = (typ'a, typ'b)
   in BNF_FP_Sugar_More.add_fp_more (type_nameoption, {
        deads = [], lives = [a], lives'= [b],
        zip = Constzip_option a b,
        unzip = Constunzip_option a b,
        zip_simps = @{thms' zip_option_simps unzip_option_simps unzip_zip_option zip_option_prj}
  }) end)



subsubsection ‹Production›

lemma [φderiver_simps, simp]:
  pred_prod (λa. True) P x  P (snd x)
  pred_prod Q (λa. True) x  Q (fst x)
  by (cases x; simp)+

declare Lifting.pred_prod_beta[φgeneration_simp]

section ‹Clean-up›

hide_const (open) introduced




chapter ‹Typeclass›

ML_file ‹library/typeclass.ML›




end